VBA Powerpoint - Equivalente ao comando Application.ScreenUpdating

Termo de Responsabilidade

' UserDefined Error codes

Const ERR_NO_WINDOW_HANDLE As Long = 1000Const ERR_WINDOW_LOCK_FAIL As Long = 1001Const 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 Else
            Err.Raise Number:=vbObjectError + ERR_VERSION_NOT_SUPPORTED, _
            Description:="Supported for PowerPoint 97/2000/2002/2003 only."
            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
        End If

      Else

        ' Unlock the Window to refresh

        LockWindowUpdate (0&)
        UpdateWindow (hwnd)
        hwnd = 0
      End If


End Property

'Sample Usage:

Sub LongProcessingSub()

' Lock screen redraw

ScreenUpdating=False

' --- Long time consuming code

' Redraw screen again

ScreenUpdating=True

' Also see below article for another example of usage of the code

End Sub

Tags: VBA, Powerpoint, refresh