Turn off screenupdating for Powerpoint

匿名 (未验证) 提交于 2019-12-03 01:19:01

问题:

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!

回答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 


易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!