Turn off screen for Powerpoint

Question

I am writing a script that goes through a folder and creates graphs from some criteria, and then exports them to powerpoint. Currently, creating 130 schedules takes 290 seconds, of which 286 use powerpoint. I suspect the main reason for this is the inability to turn off escaping for PowerPoint. I decided to use the code http://skp.mvps.org/ppt00033.htm here to solve this problem. However, I do not notice any effect. Although I can use the alt-tab and keep the powerpoint in the background, when switching to Powerpoint, all changes are displayed, and you can basically see how this slows down the program. Does anyone know how I should use this code? Should it be in the class module, should I do something else or what am I doing wrong? The following is a snippet of code that I borrowed and an example of how I am trying to name it:

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 

Thank you very much in advance. It is very strange that this functionality is not available, now I need your help!

Answer 1

Assuming you put your code in a module of class Class1, you create an instance in your main code, like this ...

 Dim myClass1 as Class1 Set myClass1 = New Class1 Class1.ScreenUpdating = False 

EDIT: just use the code as it was originally written: no need to add anything. The bad news is that when tested in PPT 2013, speed doesn't matter. You can check if it works by leaving it in False.

CScreenUpdating class module ...

 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 

Usage example ...

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