I have long processes in Excel VBA going through a variety of steps, where I just need users to sit and wait for completion. I've written a progress bar module to reassure them that it's still churning. Typically, it would work like this:
- Disable screen updating
- Call progressbar to say what's being done and/or give completion percentage
- Do something
- Call progressbar to update step description and/or completion percentage.
- Do something else
- Call progressbar again
- ...
- Call progressbar to tell the user that the process is complete.
I've tried making the progress window modal, but it halts any processing until the user does something, which is not what I want.
How can I make my progress window "semi-modal", so that it stays displayed until I say so, but doesn't prevent further processing? I want users to be able to switch to a different application, but when they switch back to Excel, I'd like them to see the progress window and nothing else.
Here's the userform:
And here's my code.
Sub MyProgressBar(ByVal MyProgress As Long, Optional ByVal TotalItems As Long, _
Optional ByVal StatusMessage As String, _
Optional ActionTitle As String, Optional PartialCompletion As String, _
Optional ItemName As String)
Dim MyAdjustedProgress As Double
' You can specify either a simple progress number,
' or a progress number as compared to a total number of items,
' or a progress as a percentage
' set window title if provided; otherwise, keep existing one
If ActionTitle <> "" Then
dlgMyProgressWindow.Caption = ActionTitle
End If
If PartialCompletion = "" Then PartialCompletion = "100%"
If ItemName = "" Then ItemName = "item"
' Adjust progress according to completion of a specific step
If Right(PartialCompletion, 1) = "%" And IsNumeric(Left(PartialCompletion, Len(PartialCompletion) - 1)) _
And CLng(Left(PartialCompletion, Len(PartialCompletion) - 1)) >= 0 _
And CLng(Left(PartialCompletion, Len(PartialCompletion) - 1)) <= 100 _
Then
MyAdjustedProgress = MyProgress - 1 + CLng(Left(PartialCompletion, Len(PartialCompletion) - 1)) / 100
Else
MyAdjustedProgress = MyProgress
End If
Select Case MyProgress
Case Is < 0
' if Myprogress is negative, display a completion message
On Error Resume Next ' in case the window was not visible yet
dlgMyProgressWindow.Hide ' Hide modeless window
On Error GoTo 0
If StatusMessage = "" Then StatusMessage = "Complete"
If Not IsMissing(TotalItems) Then
If TotalItems < 0 Then Exit Sub 'If we change total items to a negative value, just hide the window
End If
MsgBox prompt:=StatusMessage, Buttons:=vbOKOnly + vbInformation + vbMsgBoxSetForeground, _
Title:=dlgMyProgressWindow.Caption
' otherwise,
Case Else
dlgMyProgressWindow.lbsPleaseWait.visible = True
dlgMyProgressWindow.lblMyProgressBar.Width = 1 ' reset it to 1 temporarily, in case it's the first time
dlgMyProgressWindow.lblMyProgressBar.visible = True
' Show status message if provided
If StatusMessage <> "" Then
dlgMyProgressWindow.lblProgressMessage.Caption = StatusMessage
End If
' N.B. full bar size is 300
' If Total items is not specified, assume that progress is a percentage
If TotalItems = 0 Then
dlgMyProgressWindow.lblMyProgressBar.Width = 3 * (MyAdjustedProgress Mod 100)
Else
dlgMyProgressWindow.lblMyProgressBar.Width = 300 * (MyAdjustedProgress / TotalItems)
dlgMyProgressWindow.lblProgressMessage = _
"Processing " & ItemName & " " & MyProgress & " of " & TotalItems _
& vbCr & vbCr & StatusMessage
End If
On Error Resume Next 'show or just repaint
dlgMyProgressWindow.Repaint
dlgMyProgressWindow.Show vbModeless
On Error GoTo 0
End Select
End Sub