关闭 Powerpoint 的屏幕更新
Turn off screenupdating for Powerpoint
我正在编写一个循环遍历文件夹并根据某些条件创建图表的脚本，然后将这些导出到 powerpoint。目前，创建 130 个图表需要 290 秒，其中 286 个用于 powerpoint。我怀疑一个主要原因是无法关闭 powerpoint 的屏幕更新。我尝试使用此处 http://skp.mvps.org/ppt00033.htm 中的代码来解决此问题。但是，我没有注意到任何效果。虽然我可以按 alt-tab 键并在后台保留 powerpoint，但当切换到 Powerpoint 时，所有更改都会显示出来，您基本上可以看到它是如何减慢程序速度的。有人知道我如何使用这段代码吗？它应该在 class 模块中，我应该做任何其他事情还是我做错了什么？下面是我借用的代码片段以及我如何调用它的示例：
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
非常感谢。很奇怪，这个功能不是现成的，现在我需要你的帮助！
假设您将代码放在名为 Class1 的 class 模块中，您在主代码中创建一个实例，如下所示...
Dim myClass1 as Class1
Set myClass1 = New Class1
Class1.ScreenUpdating = False
编辑：只需使用最初编写的代码即可：无需添加任何内容。
坏消息是它对我在 PPT 2013 中的测试速度没有任何影响。您可以通过将其设置为 False 来验证它是否正常工作。
Class 模块 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
我发现的一个解决方法是最小化 PPT window，然后使用 EnableWindow 来防止用户输入。使用 Office 365 测试，来自 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
我只是在打开文件后最小化了 PowerPoint Window，并在构建完成后将其最大化。
ppApp.ActiveWindow.WindowState = ppWindowMinimized
VBA
ppApp.ActiveWindow.WindowState = ppWindowMaximized
我正在编写一个循环遍历文件夹并根据某些条件创建图表的脚本，然后将这些导出到 powerpoint。目前，创建 130 个图表需要 290 秒，其中 286 个用于 powerpoint。我怀疑一个主要原因是无法关闭 powerpoint 的屏幕更新。我尝试使用此处 http://skp.mvps.org/ppt00033.htm 中的代码来解决此问题。但是，我没有注意到任何效果。虽然我可以按 alt-tab 键并在后台保留 powerpoint，但当切换到 Powerpoint 时，所有更改都会显示出来，您基本上可以看到它是如何减慢程序速度的。有人知道我如何使用这段代码吗？它应该在 class 模块中，我应该做任何其他事情还是我做错了什么？下面是我借用的代码片段以及我如何调用它的示例：
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
非常感谢。很奇怪，这个功能不是现成的，现在我需要你的帮助！
假设您将代码放在名为 Class1 的 class 模块中，您在主代码中创建一个实例，如下所示...
Dim myClass1 as Class1
Set myClass1 = New Class1
Class1.ScreenUpdating = False
编辑：只需使用最初编写的代码即可：无需添加任何内容。 坏消息是它对我在 PPT 2013 中的测试速度没有任何影响。您可以通过将其设置为 False 来验证它是否正常工作。
Class 模块 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
我发现的一个解决方法是最小化 PPT window，然后使用 EnableWindow 来防止用户输入。使用 Office 365 测试，来自 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
我只是在打开文件后最小化了 PowerPoint Window，并在构建完成后将其最大化。
ppApp.ActiveWindow.WindowState = ppWindowMinimized
VBA
ppApp.ActiveWindow.WindowState = ppWindowMaximized