关闭Powerpoint的屏幕更新

用户名

我正在编写一个脚本,该脚本循环遍历一个文件夹并根据某些条件创建图形,然后将其导出到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

提前谢谢了。很奇怪,此功能尚不可用,现在我需要您的帮助!

酷蓝

假设将代码放在名为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

本文收集自互联网,转载请注明来源。

如有侵权,请联系 [email protected] 删除。

编辑于
0

我来说两句

0 条评论
登录 后参与评论

相关文章