There are a number of instances where one may want to show a message for a specific duration. In other instances it might be for a specific duration or until the user acknowledges the message, whichever comes first. In the first category would be something like a splash screen or a very brief acknowledgment of some activity. In the latter category might fall a custom splash screen or a check to see if the workbook is still in use.
And, I am sure the readers will come up with various different uses for this technique. This tip explores several ways of doing the needful.
The Windows Script Host Shell Object PopUp method
A userform with a countdown timer
A userform and the TM VBA Timer add-in
This is probably the simplest way to show a message for a specific duration. However, it is a simple test message and one cannot introduce a capability for the user to acknowledge it and cut short the display.
Option Explicit
Const ShowDurationSecs As Integer = 5
Sub showStatusBar()
Application.StatusBar = "Hello There"
Application.OnTime _
Now() + TimeSerial(0, 0, ShowDurationSecs), _
"hideStatusBar"
End Sub
Private Sub hideStatusBar()
Application.StatusBar = False
End Sub
Of course, the status bar is at best a very subtle display and the user may not even notice the message. In addition, it is possible that the status bar is not visible (this is a configuration option for older versions of Excel).
This is possibly as easy to use as the previous approach except that it uses an object external to Excel. The Windows Script Host Shell object PopUp method is very much like the VBA MsgBox with a built-in timer to close the display after a specific duration.
Option Explicit
Const ShowDurationSecs As Integer = 5
Sub useShellPopUp()
Dim Rslt As Integer
Rslt = CreateObject("WScript.Shell").PopUp( _
"Hello There", ShowDurationSecs, "Message Title")
MsgBox Rslt
End Sub
The result will be
By modifying the last argument (not shown in the previous example, one can change the types of buttons shown. The method returns a -1 if the time expires. Otherwise the returned value indicates the action taken by the user. In the example below the 4 indicates we want the Yes and No buttons shown and the 32 indicates we want to show a query question mark. As before, if the time expires PopUp will return -1. If the user clicks Yes, the result will be 6 and for No the result will be 7.
Option Explicit
Const ShowDurationSecs As Integer = 5
Sub inactivityShellPopUp()
Dim Rslt As Integer
Rslt = CreateObject("WScript.Shell").PopUp( _
"Keep this workbook open?", ShowDurationSecs, _
"Message Title", 4 + 32)
MsgBox Rslt
End Sub
The display will look like:
If the timeout parameter is missing or is zero, the dialog box will remain open until the user takes some action.
For more on this method see the MSDN documentation at http://msdn.microsoft.com/en-us/library/x83z1d9f%28v=VS.85%29.aspx
A userform is more work than any of the previous options but it comes with its benefits. We start with a simple form with a text message that the user can dismiss by clicking the ‘X’ button. The form contains a simple label as shown below.
The code to show the userform and hide it after a specific duration:
Option Explicit
Const ShowDurationSecs As Integer = 5
Sub useUF1()
Application.OnTime _
Now() + TimeSerial(0, 0, ShowDurationSecs), _
"hideUFMessage"
ufMessage.Show
End Sub
Sub hideUFMessage()
ufMessage.Hide
End Sub
The result looks as below. The dialog box will disappear after 5 seconds or when the user clicks the ‘X’ close button.
Since this is a userform, one can customize it further. By adding an image control one can show an image.
One of the advantages of using a userform is that added customizability that comes with it. In this case we can add a countdown timer that shows how many seconds are left before we automatically close the userform. The label with the number 99 is named TimeLeft.
The code to manage this new technique is below. The startCountDown subroutine initializes various variables, schedules the updateTimer subroutine, and then shows the ufCheckCloseWB userform. updateTimer checks if time has run out and if so it calls the closeWB subroutine. Otherwise, it updates the userform countdown filed (ufCheckCloseWB.TimeLeft) and reschedules itself for 1 second later. The closeWB subroutine calls the EndTimer routine to terminate the timer and close the userform. It would then do whatever the code indicated.
Option Explicit
Const ShowDurationSecs As Integer = 5
Dim NextTime As Date, TimeLeft As Integer
Sub startCountDown()
NextTime = Now() + TimeSerial(0, 0, 1)
TimeLeft = ShowDurationSecs
Application.OnTime NextTime, "updateTimer"
With ufCheckCloseWB
.TimeLeft = TimeLeft
.Show
End With
End Sub
Private Sub updateTimer()
TimeLeft = TimeLeft - 1
If TimeLeft <= 0 Then closeWB: Exit Sub
With ufCheckCloseWB
.TimeLeft = TimeLeft
.Repaint
DoEvents
End With
NextTime = Now() + TimeSerial(0, 0, 1)
Application.OnTime NextTime, "updateTimer"
End Sub
Sub endTimer()
On Error Resume Next
Application.OnTime NextTime, "updateTimer", , False
On Error GoTo 0
ufCheckCloseWB.Hide
End Sub
Sub closeWB()
endTimer
'do whatever
End Sub
The code in the ufCheckCloseWB module is relatively simple. The No button and the Yes button click events are shown below. They essentially call the already programmed routines closeWB and endTimer respectively.
Option Explicit
Private Sub No_Click()
closeWB
End Sub
Private Sub Yes_Click()
endTimer
End Sub
The problem with the code in the previous section is that it mixes managing the timer, managing the userform, and the code is split, at least to some extent, between the userform module and the standard module.
By using the TM VBA Timer add-in (http://www.tushar-mehta.com/excel/software/vba_timer/), one can create an event driven timer interface. This removes managing the timer (though one does have to manage the Timer interface) and simplifies the architecture through the use of events.
First, download and load the TM VBA Timer add-in. Now, in the workbook with the userform set a reference to the add-in.
Now, in the userform code module, we will add the code to initialize and respond to events from the clsTimer class object.
Option Explicit
Dim WithEvents myTimer As TMTimer.clsTimer
Const ShowDurationSecs As Integer = 5
Private Sub myTimer_CountdownComplete()
Me.Hide
closeWB
End Sub
Private Sub myTimer_TimerTick(TimerVal As Single)
Me.TimeLeft = Round(myTimer.CurrentMilliSecsLeft / 1000, 0)
End Sub
Private Sub initTimer()
Set myTimer = TMTimer.createTimer
With myTimer
.TimerType = .TimerTypeCountdown
.CountdownDurationMilliSecs = ShowDurationSecs * 1000
'.TickIntervalMilliSecs = 1 * 1000
.startTimer
End With
End Sub
Private Sub No_Click()
myTimer.cancelTimer
myTimer_CountdownComplete
End Sub
Private Sub Yes_Click()
myTimer.cancelTimer
Me.Hide
End Sub
Private Sub UserForm_Activate()
initTimer
End Sub
Sub closeWB()
Debug.Print "Do whatever in closeWB"
End Sub
The code in the standard module becomes the trivial
Option Explicit
Sub doCountdown()
ufCheckCloseWB.Show
End Sub
The result, with a slight twist on what is in the userform
In this tip I showed several different ways in which a developer can show a message for a specified duration.
