8

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 seconds, of which 286 are used by powerpoint. I suspect a major reason for this is not being able to turn off screenupdating for powerpoint. I have tried using code from here http://skp.mvps.org/ppt00033.htm to solve this. However, I'm not noticing any effect. While I can alt-tab and keep powerpoint in the background, when switching to Powerpoint all the changes are being shown and you can basically see how it slows down the program. Anybody knows how I am to use this code? Should it be in a class module, should I do anything else or what am I doing wrong? Below is the code-snippet I have borrowed and an example of how I try to call 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

Many thanks in advance. Very strange that this functionality is not readily available, now I need your help!

user3098568
  • 135
  • 1
  • 2
  • 7
  • Yes, I t needs to be in a Class module. You then need to create an instance and access its ScreenUpdating property. – Cool Blue Feb 14 '15 at 01:54
  • How do I do this? I have not worked with class modules before. I tried copying all the code above into a class module and then added Set ScreenUpdating = New ScreenUpdating in my regular module, to no avail. Could you be a bit more specific? – user3098568 Feb 14 '15 at 02:06

3 Answers3

4

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
Cool Blue
  • 6,438
  • 6
  • 29
  • 68
  • Thanks, I was actually able to figure out this myself once I saw that the class was named "Class1" by default and not ScreenUpdating. However, I still can't get it to work and when reviewing the code I can't see what should invoke the lockwindowcommand? It just checks what version it is and that no error codes are thrown should the lockcommand be used. However, it never seems to actually call this function? I added the line "LockWindowUpdate (0&)" after the "If LockWindowUpdate(hwnd) = 0"-paragraph, but I couldn't really notice a difference. – user3098568 Feb 14 '15 at 02:45
  • Can you post your graph loading code to help with testing? And it calls it with this line of code `LockWindowUpdate (hwnd)` – Cool Blue Feb 14 '15 at 03:05
  • Oh, I see... that was added by you. In fact the original code calls it here: `If LockWindowUpdate(hwnd) = 0 Then` – Cool Blue Feb 14 '15 at 03:27
  • Great, now I think I kind of get the hang of how it works...still, the updating doesn't turn off. I suspect this is because the code is run through Excel (maybe I should have been more clear on that). I changed the "Application.Version" part to "PowerPointApp.Version" where PPTApp is declared as a PowerPoint.Application object. So it now correctly checks the powerpoint version instead of the excel version, but the "lock window" seems to apply yo Excel still. How do I get it to refer to PowerPointApp? Activating PPT doesn't seem to help. – user3098568 Feb 14 '15 at 13:20
  • So I think I got it to work now, thanks a lot! As you say, I'm not sure it improved the speed though. Also, if I switch to another program and then back to PPT the screen updates again but maybe this is to be expected? – user3098568 Feb 14 '15 at 16:33
  • 1
    Depending on what you're doing, you might get more of a speed boost by launching PPT and opening your new presentation windowlessly. – Steve Rindsberg Feb 14 '15 at 17:41
  • I'd echo Steve's comment: it is possible to open PowerPoint Application class with its `.WithWindow = False` property. But there are some things which cannot be done with windowless presentations, still, it might be worth a shot but I'd need to see more of your code (specifically what you're doing *to* the PowerPoint objects...). If you want to entertain that option, go ahead and ask it as a new question :) – David Zemens Feb 14 '15 at 23:35
  • +1 David's request. Another thing that can slow your code down by at least an order of magnitude is selecting shapes. You can almost always get by w/o doing this, one way or another. – Steve Rindsberg Feb 15 '15 at 23:57
  • Seems like I missed the last few tips. I tried them out somewhat but couldn't get the WithWindow = False to work. Still, I got the program to work pretty well so I think I'm happy for the moment. Thanks! – user3098568 Mar 05 '15 at 12:23
1

I just minimized the PowerPoint Window after I opened the file and Maximized it when the building was done.

ppApp.ActiveWindow.WindowState = ppWindowMinimized

VBA

ppApp.ActiveWindow.WindowState = ppWindowMaximized
General Grievance
  • 4,555
  • 31
  • 31
  • 45
jBeats
  • 11
  • 1
0

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