Wyłącz screenupdating dla programu Powerpoint

Question

Piszę skrypt, który wykonuje pętlę w folderze i tworzy wykresy z pewnych kryteriów, a następnie eksportuje je do punktu PowerPoint. W tej chwili stworzenie 130 wykresów zajmuje 290 sekund, z których 286 jest używanych przez powerpoint. Podejrzewam, że głównym powodem tego nie jest wyłączenie screenupdating na powerpoint. Próbowałem użyć kodu z tutaj http://skp.mvps.org/ppt00033.htm, aby rozwiązać ten problem. Jednak nie zauważam żadnego efektu. Chociaż mogę zmieniać tabulator i utrzymywać powerpoint w tle, po przejściu do programu Powerpoint wyświetlane są wszystkie zmiany i można zasadniczo zobaczyć, jak spowalnia to program. Ktoś wie, jak używać tego kodu? Czy powinienem to zrobić w module zajęć, czy powinienem zrobić cokolwiek innego lub co robię źle? Poniżej znajduje się fragment kodu mam pożyczone i przykładem, jak próbuję to nazwać:

Option Explicit 
' UserDefined Error codes 
Const ERR_NO_WINDOW_HANDLE As Long = 1000 
Const ERR_WINDOW_LOCK_FAIL As Long = 1001 
Const ERR_VERSION_NOT_SUPPORTED As Long = 1002 

' API declarations for FindWindow() & LockWindowUpdate() 
' Use FindWindow API to locate the PowerPoint handle. 
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As Long) As Long 

' Use LockWindowUpdate to prevent/enable window refresh 
Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long 

' Use UpdateWindow to force a refresh of the PowerPoint window 
Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long 

Property Let ScreenUpdating(State As Boolean) 

Static hwnd As Long 
Dim VersionNo As String 
' Get Version Number 
    If State = False Then 
     VersionNo = Left(Application.Version, InStr(1, Application.Version, ".") - 1) 
     'Get handle to the main application window using ClassName 
     Select Case VersionNo 
     Case "8" 
     ' For PPT97: 
      hwnd = FindWindow("PP97FrameClass", 0&) 
     Case "9" 
     ' For PPT2K: 
      hwnd = FindWindow("PP9FrameClass", 0&) 
     Case "10" 
     ' For XP: 
     hwnd = FindWindow("PP10FrameClass", 0&) 
     Case "11" 
     ' For 2003: 
     hwnd = FindWindow("PP11FrameClass", 0&) 
     Case "12" 
     ' For 2007: 
     hwnd = FindWindow("PP12FrameClass", 0&) 
     Case "14" 
     ' For 2010: 
     hwnd = FindWindow("PPTFrameClass", 0&) 
     Case Else 
     Err.Raise Number:=vbObjectError + ERR_VERSION_NOT_SUPPORTED, _ 
     Description:="Newer version." 
     Exit Property 
     End Select 

     If hwnd = 0 Then 
     Err.Raise Number:=vbObjectError + ERR_NO_WINDOW_HANDLE, _ 
     Description:="Unable to get the PowerPoint Window handle" 
     Exit Property 
     End If 

     If LockWindowUpdate(hwnd) = 0 Then 
       Err.Raise Number:=vbObjectError + ERR_WINDOW_LOCK_FAIL, _ 
     Description:="Unable to set a PowerPoint window lock" 
     Exit Property 
     Else 
     LockWindowUpdate (hwnd) 
     End If 

    Else 
    'Unlock the Window to refresh 
    LockWindowUpdate (0&) 
    UpdateWindow (hwnd) 
    hwnd = 0 
    End If 
End Property 


Sub TestSub() 
' Lock screen redraw 
If ScreenUpdatingOff = True Then ScreenUpdating = False 

' --- Loop through charts in Excel and export them to Powerpoint 
' Redraw screen again 
ScreenUpdating = True 

End Sub 

Wiele z góry dzięki. Bardzo dziwne, że ta funkcja nie jest łatwo dostępna, teraz potrzebuję twojej pomocy!

Answer 1

Zakładając umieścić swój kod w module klasy o nazwie Class1, należy utworzyć instancję w głównym kodzie jak to ...

Dim myClass1 as Class1 

Set myClass1 = New Class1 

Class1.ScreenUpdating = False 

EDIT: Wystarczy użyć kodu jak to było pierwotnie napisane: nie ma potrzeby dodać coś. Zła wiadomość jest taka, że ​​nie ma to wpływu na szybkość w moich testach w PPT 2013. Możesz sprawdzić, czy działa on, pozostawiając ustawienie Fałsz.

moduł klasy cScreenUpdating ...

Option Explicit 
' UserDefined Error codes 
Const ERR_NO_WINDOW_HANDLE As Long = 1000 
Const ERR_WINDOW_LOCK_FAIL As Long = 1001 
Const ERR_VERSION_NOT_SUPPORTED As Long = 1002 

' API declarations for FindWindow() & LockWindowUpdate() 
' Use FindWindow API to locate the PowerPoint handle. 
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ 
       (ByVal lpClassName As String, _ 
       ByVal lpWindowName As Long) As Long 

' Use LockWindowUpdate to prevent/enable window refresh 
Private Declare Function LockWindowUpdate Lib "user32" _ 
       (ByVal hwndLock As Long) As Long 

' Use UpdateWindow to force a refresh of the PowerPoint window 

Private Declare Function UpdateWindow Lib "user32" (ByVal hWnd As Long) As Long 

Property Let ScreenUpdating(State As Boolean) 

Static hWnd As Long 
Dim VersionNo As String 

' Get Version Number 

    If State = False Then 
    VersionNo = Left(Application.Version, _ 
     InStr(1, Application.Version, ".") - 1) 

    'Get handle to the main application window using ClassName 

    Select Case VersionNo 

     Case "8" 
     ' For PPT97: 
      hWnd = FindWindow("PP97FrameClass", 0&) 
     Case "9" 
     ' For PPT2K: 
      hWnd = FindWindow("PP9FrameClass", 0&) 
     Case "10" 
     ' For XP: 
     hWnd = FindWindow("PP10FrameClass", 0&) 
     Case "11" 
     ' For 2003: 
     hWnd = FindWindow("PP11FrameClass", 0&) 
     Case "12" 
     ' For 2007: 
       hWnd = FindWindow("PP12FrameClass", 0&) 
     Case "14", "15" 
     ' For 2010: 
       hWnd = FindWindow("PPTFrameClass", 0&) 
     Case Else 
     Err.Raise Number:=vbObjectError + ERR_VERSION_NOT_SUPPORTED, _ 
     Description:="Newer version." 
     Exit Property 

    End Select 

    If hWnd = 0 Then 
    ' window was not found... 
     Err.Raise Number:=vbObjectError + ERR_NO_WINDOW_HANDLE, _ 
     Description:="Unable to get the PowerPoint Window handle" 
     Exit Property 
    End If 

    'Attempt to lock the window 
    If LockWindowUpdate(hWnd) = 0 Then 
    ' attempt failed... 
     Err.Raise Number:=vbObjectError + ERR_WINDOW_LOCK_FAIL, _ 
     Description:="Unable to set a PowerPoint window lock" 
     Exit Property 

    End If 

    Else 'State = True 
    'Unlock the Window to refresh 
    LockWindowUpdate (0&) 
    UpdateWindow (hWnd) 
    hWnd = 0 
    End If 

End Property 

Przykład użycia ...

Set appObject = New cScreenUpdating 
    appObject.ScreenUpdating = False 
    ' code here 
    appObject.ScreenUpdating = True