vba 关闭 Powerpoint 的屏幕更新
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/28511508/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Turn off screenupdating for Powerpoint
提问by user3098568
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.htmto 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:
我正在编写一个脚本，循环遍历文件夹并根据某些条件创建图形，然后将这些导出到 powerpoint。目前，创建 130 个图表需要 290 秒，其中 286 个由 powerpoint 使用。我怀疑造成这种情况的一个主要原因是无法关闭 powerpoint 的屏幕更新。我曾尝试使用http://skp.mvps.org/ppt00033.htm 中的代码来解决此问题。但是，我没有注意到任何影响。虽然我可以使用 alt-tab 并将 powerpoint 保留在后台，但当切换到 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
Many thanks in advance. Very strange that this functionality is not readily available, now I need your help!
提前谢谢了。很奇怪这个功能不是现成的，现在我需要你的帮助！
采纳答案by Cool Blue
Assuming you put your code in a class module called Class1, you create an instance in your main code like this...
假设您将代码放在名为 Class1 的类模块中，您在主代码中创建一个实例，如下所示...
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.
编辑：只需使用最初编写的代码：无需添加任何内容。坏消息是，它对我在 PPT 2013 中的测试速度没有任何影响。您可以通过将其设置为 False 来验证其是否有效。
Class module cScreenUpdating...
类模块 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
