关闭 Powerpoint 的屏幕更新

Posted 2023-02-19

技术标签:

【中文标题】关闭 Powerpoint 的屏幕更新【英文标题】：Turn off screenupdating for Powerpoint 【发布时间】：2015-04-15 04:44:59 【问题描述】：

我正在编写一个循环遍历文件夹并根据某些标准创建图形的脚本，然后将它们导出到 powerpoint。目前，创建 130 个图表需要 290 秒，其中 286 个由 powerpoint 使用。我怀疑造成这种情况的主要原因是无法关闭 powerpoint 的屏幕更新。我已经尝试使用这里的代码http://skp.mvps.org/ppt00033.htm 来解决这个问题。但是，我没有注意到任何影响。虽然我可以 alt-tab 并将 powerpoint 保留在后台，但当切换到 Powerpoint 时，所有更改都会显示出来，您基本上可以看到它是如何减慢程序的。有人知道我如何使用此代码吗？它应该在类模块中，我应该做其他事情还是我做错了什么？以下是我借用的代码-sn-p 以及我如何尝试调用它的示例：

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

提前非常感谢。很奇怪，这个功能还不是现成的，现在需要你的帮助！

【问题讨论】：

是的，它需要在 Class 模块中。然后，您需要创建一个实例并访问其 ScreenUpdating 属性。我该怎么做？我以前没有使用过类模块。我尝试将上面的所有代码复制到一个类模块中，然后在我的常规模块中添加 Set ScreenUpdating = New ScreenUpdating，但无济于事。能具体一点吗？ 【参考方案1】：

假设您将代码放在名为 Class1 的类模块中，您将在主代码中创建一个实例，如下所示...

Dim myClass1 as Class1

Set myClass1 = New Class1

Class1.ScreenUpdating = False

编辑：只需使用最初编写的代码即可：无需添加任何内容。坏消息是它对我在 PPT 2013 中的测试速度没有任何影响。您可以通过将其设置为 False 来验证它是否正常工作。

类模块 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

【讨论】：

谢谢，当我看到该类默认命名为“Class1”而不是 ScreenUpdating 时，我实际上能够自己弄清楚这一点。但是，我仍然无法让它工作，并且在查看代码时我看不到应该调用 lockwindow 命令的内容？它只是检查它是什么版本，并且在使用 lock 命令时不会抛出错误代码。但是，它似乎从来没有真正调用过这个函数？我在“If LockWindowUpdate(hwnd) = 0”段落之后添加了“LockWindowUpdate (0&)”行，但我并没有真正注意到差异。你能发布你的图形加载代码来帮助测试吗？它用这行代码调用它LockWindowUpdate (hwnd) 哦，我明白了……这是你添加的。事实上，原始代码在这里调用它：If LockWindowUpdate(hwnd) = 0 Then 太好了，现在我想我有点明白它是如何工作的了……不过，更新并没有关闭。我怀疑这是因为代码是通过 Excel 运行的（也许我应该对此更清楚）。我将“Application.Version”部分更改为“PowerPointApp.Version”，其中 PPTApp 被声明为 PowerPoint.Application 对象。所以它现在正确地检查了 powerpoint 版本而不是 excel 版本，但“锁定窗口”似乎仍然适用于 Excel。我如何让它引用 PowerPointApp？激活 PPT 似乎没有帮助。根据您所做的工作，您可能会通过启动 PPT 并无窗口打开新演示文稿来获得更多的速度提升。【参考方案2】：

我发现的一种解决方法是最小化 PPT 窗口，然后使用 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 的屏幕更新的主要内容，如果未能解决你的问题，请参考以下文章

幻灯片是什么

如何使用我的数据框更新 powerpoint？

当我在 vba powerpoint 中按下一个键时调用一个 Sub

屏幕打开/关闭时如何更新 Android 小部件？

Android 回合制多人游戏 - 如何在屏幕关闭时获取比赛更新？

如何连续刷新屏幕并实时更新[关闭]