Excel & Word have the ScreenUpdating method thru
which a developer can lock the main window from unnecessarily redrawing
itself whilst the macro is being executed. This method is however not
present in PowerPoint. If left alone, redrawing is not only ugly on the
eyes it also takes more time for the macro to reach completion. Hence I
created this generic wrapper to lock the window
updates.
' --------------------------------------------------------------------------------
' Copyright ©1999-2007, Shyam Pillai, All Rights Reserved.
' --------------------------------------------------------------------------------
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
'
--------------------------------------------------------------------------------
' 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 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
|