closuresPowerpoint的屏幕更新
我正在编写一个脚本，通过一个文件夹循环，并从一些条件创buildgraphics，然后将其导出到powerpoint。 目前，创build130个graphics需要290秒，其中286个被powerpoint使用。 我怀疑这个主要原因是无法closures屏幕更新。 我已经尝试使用从这里http://skp.mvps.org/ppt00033.htm的代码来解决这个问题。 但是，我没有注意到任何影响。 虽然我可以在后台切换并保留幻灯片，但在切换到Powerpoint时，所有更改都将显示出来，您可以基本看到它如何减慢程序的速度。 任何人都知道我是如何使用这个代码？ 如果是在类模块中，我应该做别的什么，或者我做错了什么？ 下面是我借用的代码片段和一个我如何尝试调用它的例子：
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 提前谢谢了。 很奇怪，这个function不是现成的，现在我需要你的帮助！
假设你把你的代码放在一个名为Class1的类模块中，你可以像这样在你的主代码中创build一个实例。
Dim myClass1 as Class1 Set myClass1 = New Class1 Class1.ScreenUpdating = False
编辑：只要使用代码，因为它最初写：不需要添加任何东西。 坏消息是加快我在PPT 2013的testing速度并没有什么区别。你可以通过将它设置为False来validation它的工作。
类模块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
用法示例…
Set appObject = New cScreenUpdating appObject.ScreenUpdating = False ' code here appObject.ScreenUpdating = True