Pausing Code Execution
This page describes several methods of pausing code execution.
There may be circumstances under which you want to pause code execution for some
period of time, such as to allow the user to update a worksheet or an asynchronous task to
finish. There are (at least) four ways of doing this. Two of the methods (SetTimer
and a tight timer loop) allow other code to execute and events to be raised while the code is waiting.
The other two methods (Sleep and Wait)
defer events until the timeout period has expired.
You can use Application.Wait to pause execution until a time is
reached. For example,
Application.Wait Now + TimeSerial(0, 0, SecondsToWait)
Code execution will pause on this line for SecondsToWait seconds. During this
period, you are locked out of the application. Any events, such as a command button's Click
event or an Application.OnTime event, are deferred until the Wait
timer expires. The BREAK key is deferred until the wait expires. You cannot break out of the wait. However,
background tasks such as calculation and printing can continue to execute during the Wait period.
Windows provides an API function named Sleep that suspends the current
process thread for some number of milliseconds. During this wait period, you are locked out of the
application and all events are deferred until the wait is complete. The BREAK key cannot be used
to break out of the wait.
#If VBA7 And Win64 Then
Public Declare PtrSafe Sub Sleep Lib "kernel32" ( _
ByVal dwMilliseconds As LongLong)
#Elsee
Public Declare Sub Sleep Lib "kernel32" ( _
ByVal dwMilliseconds As Long)
#End If
Sub Test()
Sleep NumberOfSeconds * 1000
End Sub
You can pause the execution by using a tight timer loop. The code doesn't exactly pause execution. Rather,
it just loops for the specified number of seconds. Within the loop, DoEvents is
called to allow keyboard and mouse events to occur. During the loop, you are not locked out of the
application and events occur normally during the loop. You can use the BREAK key to get break out of the loop.
For example,
Dim StartTick As Long
Dim CurrTick As Long
Dim EndTick As Long
On Error Goto ErrHandler
Application.EnableCancelKey = xlErrorHandler
StartTick = GetTickCount
EndTick = GetTickCount + (NumberOfSeconds * 1000)
Do
CurrTick = GetTickCount
DoEvents
Loop Until CurrTick >= EndTick
Exit Sub
ErrHandler:
EndTick = 0
This will loop for NumberOfSeconds seconds. Events occur normally during the
wait period. The BREAK key can be used to get out of the wait.
Another way to pause execution is to use the Windows SetTimer and
KillTimer function. SetTimer instructs
Windows to execute a specified procedure every NumberOfSeconds * 1000
milliseconds until KillTimer is called. During this period, the application
is free and events occur normally. For example,
#If VBA7 And Win64 Then
Public Declare PtrSafe Function SetTimer Lib "user32" ( _
ByVal HWnd As LongLong, ByVal nIDEvent As LongLong, _
ByVal uElapse As LongLong, _
ByVal lpTimerFunc As LongLong) As LongLong
Public Declare PtrSafe Function KillTimer Lib "user32" ( _
ByVal HWnd As LongLong, _
ByVal nIDEvent As LongLong) As LongLong
Public Declare PtrSafe Function GetTickCount Lib "kernel32" () As LongLong
#Else
Public Declare Function SetTimer Lib "user32" ( _
ByVal HWnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" ( _
ByVal HWnd As Long, _
ByVal nIDEvent As Long) As Long
Public Declare Function GetTickCount Lib "kernel32" () As Long
#End If
Sub StartTimer()
Dim TimerID As Long
TimerID = SetTimer(0&, 0&, NumberOfSeconds * 1000, AddressOf APITimerProc)
End Sub
#If VBA7 AND WIN64 Then
Sub APITimerProc(ByVal HWnd As LongLong, ByVal uMsg As LongLong, _
ByVal nIDEvent As LongLong, ByVal dwTimer As LongLong)
KillTimer 0&, nIDEvent
End Sub
#Else
Sub APITimerProc(ByVal HWnd As Long, ByVal uMsg As Long, _
ByVal nIDEvent As Long, ByVal dwTimer As Long)
KillTimer 0&, nIDEvent
End Sub
#End If
When the timer "pops", Windows will automatically call APITimerProc, as
specified with the AddressOf operator in the call to SetTimer.
You must not change the method signature of APITimerProc. You can
change the name of the procedure and the names of the parameters, but you must not change the number of and
data types of the parameters. If you do, Excel will likely crash.
You can use code to pause execution until the user changes a particular cell. The following code
should be placed in the ThisWorkbook code module:
Private WatchCell As Range
Private CellChanged As Boolean
Public Function WaitForUserInput(WaitSeconds As Long, _
WaitCell As Range) As Boolean
Dim TimeStart As Double
CellChanged = False
Set WatchCell = WaitCell
TimeStart = Now
Do
DoEvents
If CellChanged = True Then
WaitForUserInput = True
Exit Function
End If
Loop While Now - TimeStart < TimeSerial(0, 0, WaitSeconds)
WaitForUserInput = False
End Function
Private Sub Workbook_SheetChange(ByVal Sh As Object, _
ByVal Target As Range)
If Not WatchCell Is Nothing Then
If Not Application.Intersect(Target, WatchCell) Is Nothing Then
CellChanged = True
End If
End If
End Sub
To pause execution until user input, call WaitForUserInput passing
to it the number of seconds to wait before expiring and the the cell(s) reference to test
for changes. The function will return True if the user changes
the cell(s) before the wait expires. It will return False is the user
does not change the cell(s) within the wait time. For example,
Sub Test()
Dim B As Boolean
B = ThisWorkbook.WaitForUserInput(WaitSeconds:=10, _
WaitCell:=Worksheets(1).Range("A1"))
If B = True Then
Debug.Print "cell changed"
Else
Debug.Print "cell not changed"
End If
End Sub
This code will wait for 10 seconds for the user to modify cell A1.
|
This page last updated: 16-October-2012. |