Turn off screenupdating for Powerpoint

Question

I am writing a script that loops through a folder and creates graphs from some criteria, and then exports these to powerpoint. At the moment, creating 130 graphs takes 290 s

Answer 1

Assuming you put your code in a class module called 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 it doesn't make any difference to speed in my testing in PPT 2013. You can verify that its working though by leaving it set to False.

Class module 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

Example usage...

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

Answer 2

One workaround I found was to minimize the PPT window, and then use EnableWindow to prevent user input getting to it. Tested with Office 365, from VB.NET

<DllImport("user32.dll")>
Private Shared Function EnableWindow(ByVal hWnd As IntPtr, ByVal bEnable As Boolean) As Boolean
End Function

Private _pptApp As PowerPoint.Application

Public Property ScreenUpdating As Boolean

    Get
        Return _pptApp.WindowState=PpWindowState.ppWindowNormal
    End Get

    Set(value As Boolean)

        If value Then
            EnableWindow(_pptApp.HWND, True)
            _pptApp.WindowState = PpWindowState.ppWindowNormal
        Else
            'need to make sure it is enabled otherwise changing the state throws an exception
            EnableWindow(_pptApp.HWND, True)
            _pptApp.WindowState = PpWindowState.ppWindowMinimized
            EnableWindow(_pptApp.HWND, False)
        End If

    End Set

End Property