Disattiva screenupdating per Powerpoint

Question

Sto scrivendo uno script che scorre in una cartella e crea grafici da alcuni criteri, quindi li esporta in PowerPoint. Al momento, la creazione di 130 grafici richiede 290 secondi, di cui 286 utilizzati da powerpoint. Sospetto che una delle ragioni principali per questo non sia la possibilità di disattivare lo screenupdating per powerpoint. Ho provato a utilizzare il codice da qui http://skp.mvps.org/ppt00033.htm per risolvere questo problema. Tuttavia, non sto notando alcun effetto. Mentre sono in grado di mantenere alt-tab e mantenere powerpoint in background, quando si passa a Powerpoint vengono mostrate tutte le modifiche e si può sostanzialmente vedere come rallenta il programma. Qualcuno sa come devo usare questo codice? Dovrebbe essere in un modulo di classe, dovrei fare qualcos'altro o cosa sto sbagliando? Di seguito è riportato il codice-frammento di Ho preso in prestito e un esempio di come provo a chiamarlo:

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 

Molte grazie in anticipo. Molto strano che questa funzionalità non sia facilmente disponibile, ora ho bisogno del tuo aiuto!

Answer 1

Supponendo che si inserisce il codice in un modulo di classe denominato Class1, si crea un'istanza nel codice principale così ...

Dim myClass1 as Class1 

Set myClass1 = New Class1 

Class1.ScreenUpdating = False 

EDIT: Basta usare il codice come è stato originariamente scritto: non c'è bisogno aggiungere qualcosa. La cattiva notizia è che non fa alcuna differenza per la velocità nei miei test in PPT 2013. È possibile verificare che funzioni, lasciandolo impostato su False.

modulo Classe 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 

Esempio di utilizzo ...

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