What can you learn here?
- Timers
- Scheduling tasks
- Progress bars
Dealing with asynchronous events
VBA has Event Processing capabilities. This is how it is able to deal with mouse clicks, form events and so on. However this section is not about handling these kind of events that are triggered by ‘something happening’, but rather ‘time passing’. These concepts are implemented as progress bar and countdown timer class in this project. You can download the finished project and include it in your own projects if you need a ready built, asynchronous timer.
Application Ontime
The Excel Application provides the OnTime method as a way to schedule future events. It is rather straightforward but also picky. Here is a small program that will stop every 5 seconds to see if you want to do more. Note it will run forever. Option ExplicitDim pNextUpdate As DateConst pUpdateInterval = 5Sub testTimer() scheduleAnother While True DoEvents WendEnd SubSub scheduleAnother() pNextUpdate = Now + TimeSerial(0, 0, pUpdateInterval) Application.OnTime pNextUpdate, "popup"End SubSub popup() If MsgBox("again?", vbYesNo) = vbYes Then scheduleAnotherEnd Sub Application.Ontime’s first 2 arguments are – the time it should run, followed by the name of the procedure to run (which needs to be in the scope of the procedure initiating the .Ontime method.
DoEvents
Our main procedure does nothing but loop endlessly. In this kind of heavy compute intensive environment, Excel does not service events, so it means that the event we scheduled never gets a chance to get focus. The DoEvents command tells Excel to go have a look to see if there are any events that need to be handled.
Stopping when done
Let’s modify our example a little so that it stops running when instructed to do so. The pNextUpdate variable will be 0 if instructed to stop. Otherwise it will be the time the next msgBox is due to be displayed. Note also it’s scope – it has to have visibility across the whole module since it will be accessed in multiple procedures. Option ExplicitDim pNextUpdate As DateConst pUpdateInterval = 5Sub testTimer() scheduleAnother While pNextUpdate > 0 DoEvents Wend MsgBox ("all done")End SubSub scheduleAnother() pNextUpdate = Now + TimeSerial(0, 0, pUpdateInterval) Application.OnTime pNextUpdate, "popup"End SubSub popup() pNextUpdate = 0 If MsgBox("again?", vbYesNo) = vbYes Then scheduleAnotherEnd Sub
Making a countdown timer
There is a comprehensive countdown time class you can use implemented as part of this project. However you can see from this that we have the means to now create a report on some activity every ‘x’ seconds, which is essentially all that a countdown timer is.
Here is a very simple implementation using the cProgressBar class, that will create a couple of shapes on the current worksheet and countdown graphically every second for 15 seconds, using them till it runs out of time, and looks like this.
To implement this on a form instead, you can replace the shape with a label control on your form. You will need the cProgressBar class and the cGeneralObject class which are in the Gettingstartedseries workbook. If you are planning to use the createShapes procedure used in this example, you will also need the deviceAPI module – again, in the gettingStartedSeries workbook. Option ExplicitDim shpInner As ShapeDim shpOuter As ShapeDim ptimer As cProgressTimerSub shapeCountdownExecute() Set ptimer = New cProgressTimer createShapes With ptimer .init shpInner, "shapeUpdate", "shapeCountDownOutOfTime", 15 .Start End With MsgBox ("all set up")End Sub Sub shapepTimerDestroy() TimerDestroy ptimerEnd Sub
Public Sub shapeUpdate()
' this is an indirect call to a method because application.ontime cannot access within a class
If Not ptimer Is Nothing Then ptimer.Update End IfEnd Sub Public Sub shapeCountDownOutOfTime() outofTime ptimerEnd SubPublic Sub outofTime(pt As cProgressTimer) If Not pt Is Nothing Then With pt ' you must include this to mark that you have been called and have executed .calloutExecuted ' take some action for being out of time.. give it a bit longer and restart it If MsgBox("You have run out of time.. wait some more?", vbYesNo) = vbYes Then .ratioElapsed = 0.9 .reStart Else TimerDestroy pt End If End With End IfEnd Sub Sub TimerDestroy(pt As cProgressTimer) If Not pt Is Nothing Then pt.Destroy Set pt = Nothing End If
End Sub
Sub createShapes() Dim shp As Shape, i As Long ' create a couple of shapes With ActiveSheet ' delete any existing For i = .Shapes.Count To 1 Step -1 .Shapes(i).Delete Next i Set shpOuter = .Shapes.AddShape(msoShapeRectangle, 10, 20, 100, 20) End With With shpOuter .Line.Weight = 4 Set shpInner = ActiveSheet.Shapes.AddShape(.Type, _ .left + .Line.Weight * PixelstoPoints.left, _ .top + .Line.Weight * PixelstoPoints.top, _ .Width - .Line.Weight * PixelstoPoints.left * 2, _ .Height - .Line.Weight * PixelstoPoints.top * 2) End With With shpInner 'change to some random color .Fill.ForeColor.SchemeColor = Int(Rnd() * 56) .Line.Weight = 0 End With End Sub
Create a progress Bar
The only real difference between a countdown timer and a progress bar is that one counts down (showing time left), and the other counts up (showing progress against predicted time). Implementing a progress bar is very similar to the countdown timer above. In fact the only change required is to tell the .init method you want a progress bar instead of a countdown timer — the ‘true’ in the call below Sub shapeProgressBarExecute() Set ptimer = New cProgressTimer createShapes With ptimer .init shpInner, "shapeUpdate", "shapeCountDownOutOfTime", , True .Start End With MsgBox ("all set up")End Sub However, since a progress bar is supposed to be measuring and predicting progress, we’d better actually do some work and measure it.
Here is a typical Progress bar Implementation. In this case, I also used a parameter in .Init to indicate that I wanted to show %age completed on the bar. The bar will look like this.
Sub shapeProgressBarExecute() Dim i As Long Const cLoop = 1000000 Set ptimer = New cProgressTimer createShapes With ptimer .init shpInner, "shapeUpdate", "shapeCountDownOutOfTime", , True, , , , , True .Start End With ' ' do something lots of times For i = 1 To cLoop doSomethingComplicated ' if this happens then the form has been closed down in the middle of processing If ptimer Is Nothing Then Exit Sub ' update how much of the task is completed and bar will adjust itself on next update ptimer.ratioElapsed = CDbl(i) / cLoop Next i ' wrap up ptimer.Flush Application.Wait 1 MsgBox "Completed task in " & Format(ptimer.timeElapsed, ".##") & " seconds" shapepTimerDestroyEnd Sub The only thing you have to do here, is to communicate how much of the task is completed at opportune processing points, though use of the .ratioElapsed property. The Progress bar is only actually replotted according to the interval you specify (1 sec default). You can see that in the example above, if done synchronously, the bar would have been replot 1 million times, instead of 30 times. Note that you don’t need to worry about DoEvents. When you update the .ratioElapsed property, it will take care of it if necessary.
For more stuff see my book – Going Gas.
Summary
Although it is not as rich as other languages in dealing with asynchronous events, VBA does have enough capabilities to cover what you are likely to need in scheduling and timing. The example above can be downloaded in the Getting Started Series Workbook, and you can take a look at some more advanced progress bars and countdown timer implementations (using the same classes discussed above) here. Other examples of timing capabilities can be found here. As usual, questions and feedback are welcomed.