Views

Histats

Vitrine

VBA Powerpoint - Equivalente ao comando Application.ScreenUpdating








' 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

Inline image 1

✔ VBA Brazil®

✔ VBA Brazil®
brazilsalesforceeffectiveness@gmail.com
Related Posts Plugin for WordPress, Blogger...
diHITT - Notícias