frmProgress
The Perfect Progress Bar
A progress bar's purpose is to assure users our program is running and about when it will finish. The perfect progress bar does that and includes an optional Cancel button so users can kill processes that take too long. And it wouldn't be perfect if it wasn't simple to implement in Excel (NOTE! Windows version only!).
What makes this 'perfect'?
The perfect progress bar:
Is just one object in our VBA (a userform) making it easy to import into other projects
Can be called in just 1 line of VBA
Has an optional cancel button to interrupt process that are taking too long
Can display messages in the progress bar and in the userform's title.
Can, in many cases, predict accurately at what time our process will end.
Components
To build the user form we need 5 controls:
frmProgress - The user form
lblBack - A white label behind the expanding bar
lblBar - An expanding gray label
txtBar - A textbox with transparent background where we can display progress messages over the expanding bar.
cmdCancel - An optional command button for killing the process
Properties
Each component has properties that we must set. These dialogs show all properties for each component but there are only a few we must change from the defaults.
Forms and Classes
Forms act like classes. Like classes they have properties; they can expose methods; and we can instantiate them (create instances) by assign them to variables like so:
Dim oPrg as frmProgress
Set oPrg = New frmProgress
This is how I prefer to work with forms, especially this form, because I sometimes have one form displaying overall progress and another displaying a task's progress. By instantiating forms I can have two or more of the same form displayed with each having its own state separate from the others.
Example: Displaying the Form
The code sample below shows how to implement the progress bar with all its 'bells and whistles' (optional features) as well as adding an ETA (estimated time of arrival/completion) calculation.
Sub Test(ByVal lLoops As Long)
' Declarations
Dim oPrg As frmProgress 'User Form
Dim lLoop As Long 'Loop Counter
Dim tBegin As Date 'Timer Begin
Dim tElapsed As Date 'Elapsed Time
Dim tEstimate As Date 'ETA (Estimated time of arrival/completion)
' Error handing
On Error GoTo ErrHandler
' Initialize Variables
Set oPrg = New frmProgress
tBegin = Now()
' Procedure
For lLoop = 1 To lLoops
tElapsed = Now() - tBegin
tEstimate = tBegin + (tElapsed * lLoops) / lLoop
If oPrg .Display(fPercent:=lLoop / lLoops, _
sTitle:="Title goes here", _
sText:="Loop:" & lLoop & " ETA " & _
Format(tEstimate, "h:mm:ss AM/PM"), _
bCancel:=True) = vbCancel Then Exit For
Next
ErrHandler:
If Err.Number <> 0 Then
MsgBox _
Prompt:="Error#" & Err.Number & vbLf & Err.Description, _
Buttons:=vbCritical + vbMsgBoxHelpButton, _
Title:="frmProgressBar", _
HelpFile:=Err.HelpFile, _
Context:=Err.HelpContext
End If
' Clean Up
If Not oProgress Is Nothing Then oProgress.Hide: Set oProgress = Nothing
End Sub
Creating the form: Module Level Code
After creating the userform's visual components, display its code and enter these procedures. We start with module level code which contains some documentation and creates variables that will be accessible by all routines in this form.
' Version: 12/06/18
' Save as: frmProgress.frm
'Description: Display Progress bar
' Date Ini Modification
' 12/08/11 CWH Redesign
' 04/30/12 CWH Applied new error processing standards
' 05/22/12 CWH Added Progress Bar Text Option
' 06/29/12 CWH Checked for Percent out of range
' 01/02/13 CWH Version 2013.01
' 07/05/13 CWH Switched to clsForm and clsCmd for colors
' 09/03/14 CWH Parameter standardization
' 01/29/14 CWH Encorprated Jon Peltier's UserForm_QueryClose
' 03/14/18 CWH See Display
' 08/21/18 CWH Added cancel option
' 11/02/18 CWH Removed formatting
Option Explicit
' Private Properties
Const cModule As String = "frmProgress" 'This module's name
' Public Properties
Public bCancelled As Boolean 'Cancelled button clicked
Creating the Form: Event Code
This procedure runs when we instantiate the form. I prefer my forms be formatted and so the first two lines connect this form to clsForm (see References at bottom). If you are okay with Excel's gray format, delete those two lines.
Private Sub UserForm_Initialize()
' NOTE! Static - to keep in memory after this routine ends
Static FormClass As New clsForm
Set FormClass.UserForm = Me
bCancelled = False
End Sub
This procedure runs if the user clicks the red X in the upper right corner. This handles that event as if the user clicked cancel.
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
' If "X" clicked, cancel unloading. Use hide instead
If CloseMode = vbFormControlMenu Then
Cancel = True
bCancelled = True
Me.Hide
End If
End Sub
This procedure runs when the user clicks Cancel - if it has been enabled.
Private Sub cmdCancel_Click()
bCancelled = True
Me.Hide
End Sub
Creating the Form: Public Methods
This is what our program uses to display the form. See Example: Displaying the Form
Public Function Display(ByVal fPercent As Double, _
Optional ByVal sTitle As String = "", _
Optional ByVal sText As String = "", _
Optional ByVal bCancel As Boolean) As Long
' Description:Mimic VBA's Message Box w/benefits!
' Inputs: Message Text to display
' Title Text for the form's title
' Text Text for the Progress bar
' bCancel Cancel option flag
' Outputs: Display Success: vbOK
' Cancelled: vbCancel
' Example: ? frmProgress.Display(.50, "Validating Entries")
' Date Ini Modification
' 12/08/11 CWH Redesign
' 05/22/12 CWH Added Progress Bar Text Option
' 03/14/18 CWH Changed txtBar colors
' Error Handling and Function initialization
On Error GoTo ErrHandler
Display = vbCancel
' Check Inputs
If fPercent > 1 Then fPercent = 1
If fPercent < 0 Then fPercent = 0
' Procedure
If Not bCancelled Then
If Not Me.Visible Then
Me.cmdCancel.Visible = bCancel
Me.Height = 86 - IIf(bCancel, 0, cmdCancel.Height)
Show vbModeless
End If
Caption = sTitle
txtBar.Text = sText
lblBar.BackColor = RGB(192, 192, 192)
lblBar.Width = txtBar.Width * fPercent
DoEvents
End If
Display = IIf(bCancelled, vbCancel, vbOK)
ErrHandler:
Select Case Err.Number
Case Is = NoError: 'Do nothing
Case Else:
Select Case DspErrMsg(cModule & "." & cRoutine)
Case Is = vbAbort: Stop: Resume 'Debug mode - Trace
Case Is = vbRetry: Resume 'Try again
Case Is = vbIgnore: 'End routine
End Select
End Select
' House Keeping
bCancelled = False
End Function
References:
DspErrMsg()
clsForm()