Progress Bar for Excel

Question

Any future updates can be found at Excel-VBA-ProgressBar

---

What I've been using so far

For the last 6 years I've been using a progress form which I wrote in VBA using just Windows API calls. The code (not for review) is here: gist. It has a small demo as well.

It worked because there was no DoEvents call. So, although the form is not modal by any means, the user cannot interact with Excel itself unless stepping through code, and the bar still updates visually without freezing. I also liked that the entire code is in a single class module and never crashed.

However, there are 2 main drawbacks:

1. It only works on Windows, not Mac
2. The user cannot cancel the form as there are no events. This could be done using subclassing but I definitely don't want to go into that rabbit hole - I don't want any crashes due to Stop button being pressed or system timeouts.

There are also smaller issues like flickering.

What I wanted to achieve

I wanted a progress bar that would solve the next points:

1. Works on both Win and Mac
2. The user can cancel the displayed form via the X button, if allowed
3. The user can cancel via the Esc key, if allowed
4. The form displayed can be Modal but also Modeless, as needed
5. The progress bar would call a 'worker' routine
6. The 'worker' routine called would be able to return a value if it's a Function
7. The 'worker' routine would accept a variable number of parameters and would be able to change them ByRef if needed
8. The 'worker' routine does not need to accept the progress bar instance at a specific position in the parameter list, or at all (for whatever reason - a global variable could be used, although I would not recommend)
9. The 'worker' routine can be a macro in a workbook or a method on an object
10. The main progress bar class doesn't need a global instance nor a factory
11. Easy customizable properties
12. Has the ability to show how much time has elapsed and an approximation of how much time is left which can be useful for tasks where steps are almost equal but also the ability to turn the time off when not needed or inaccurate
13. The number of classes/modules is at a minimum. Would have preferred just one as the gist mentioned above but that's not realistic in plain VBA with no API. For example CreateObject("Forms.Form.1") does indeed create a form but it cannot be displayed. So, realistically, a class module and an actual UserForm module are needed at the very least
14. The userform module has a minimum of code. Basically, just events, that are going to get raised but nothing else and no other logic whatsoever
15. The userform module has no design time controls. This would make it easy to just create a new form in 3 steps: insert new form, rename, add events code. So, controls added at runtime
16. No interfaces because of this bug. To be honest I never got to refactor those particular large projects (mentioned in the link) and it might be the module size that is the issue (as suggested by @MathieuGuindon). But then there's also number 13 above - I prefer less modules

What's already available

On a quick search, a lot of progress bars/forms popped-up but most of them were using Win APIs which defeated the number 1 issue I had - not working on Mac. Plus, I have my own API (old an ugly) API implementation as in the mentioned gist.

And then countless posts using a Modeless userform which defeated the number 4 point raised above - need both Modal and Modeless.

And then I found the excellent article The Reusable Progress Indicator written by @MathieuGuindon. I remember reading it in a hurry when it was first posted about 3 years ago but back then the gist I linked was enough for what I was doing. Admittedly the article is rather old and the author mentioned in a few other places and articles that he needs to revisit the progress indicator. Regardless, I've read it carefully and I loved the idea of displaying a Modal form which then raises an Activated event. That's the spark I needed to start implementing my own form that solves all the other points raised above. Many thanks to the author!

Implementation

Userform

Any new userform is fine. No controls are needed and the form can be of any size. Needed:

1. Then userform name must be ProgressForm
2. The code inside the form is:

Option Explicit
Public Event Activate()
Public Event QueryClose(Cancel As Integer, CloseMode As Integer)
Private Sub UserForm_Activate()
 RaiseEvent Activate
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
 RaiseEvent QueryClose(Cancel, CloseMode)
End Sub

The form itself can be shown independently but is rather useless on it's own.

Reference

In order to achieve point 7 (variable number of parameters which preserve the ByRef flag) I needed a way to safely copy a ParamArray into a regular array. Unfortunately that cannot be done natively so I am using the function CloneParamArray from my own repository VBA-MemoryTools. I could argue that the cloning is somewhat natively as all the supporting methods copy memory natively via ByRef Variants but that's not important. So, LibMemory bas module is needed because otherwise no arguments could be changed by reference while a Modal form is displayed.

Class

The ProgressBar class code:

Option Explicit
Private WithEvents m_form As ProgressForm
Private m_allowCancel As Boolean
Private m_cancelled As Boolean
Private m_currentValue As Double
Private m_isAutoCentered As Boolean
Private m_isRunning As Boolean
Private m_procedure As String
Private m_result As Variant
Private m_showTime As Boolean
Private m_showType As FormShowConstants
Private m_startTime As Date
Private m_targetBook As Workbook
Private m_targetObj As Object
Private m_args() As Variant
'Controls
Private m_info1 As MSForms.Label
Private m_info2 As MSForms.Label
Private m_barFrame As MSForms.Frame
Private m_bar As MSForms.Label
Private m_elapsed As MSForms.Label
Private m_remaining As MSForms.Label
Private m_percent As MSForms.Label
Private WithEvents m_escButton As MSForms.CommandButton
#If Mac Then
#ElseIf VBA7 Then
Private Declare PtrSafe _
Function rtcCallByName Lib "VBE7.DLL" (ByVal targetObj As Object _
 , ByVal procNamePtr As LongPtr _
 , ByVal vCallType As VbCallType _
 , ByRef args() As Any _
 , Optional ByVal lcid As Long) As Variant
#Else
Private Declare _
Function rtcCallByName Lib "msvbvm60" (ByVal targetObj As Object _
 , ByVal procNamePtr As Long _
 , ByVal vCallType As VbCallType _
 , ByRef args() As Any _
 , Optional ByVal lcid As Long) As Variant
#End If
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Class events
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Sub Class_Initialize()
 Set m_form = New ProgressForm
 BuildForm
 With Me
 .AllowCancel = False
 .Caption = "Progress..."
 .Info1 = "Please wait..."
 .Info2 = vbNullString
 .ShowTime = False
 .ShowType = vbModal
 .CenterOnApplication
 End With
End Sub
Private Sub Class_Terminate()
 TryHideForm
 Set m_form = Nothing
End Sub
Private Sub TryHideForm()
 On Error Resume Next 'Avoid error 402
 m_form.Hide
 On Error GoTo 0
End Sub
'*******************************************************************************
'Builds the necessary controls and alignment at runtime
'*******************************************************************************
Private Sub BuildForm()
 Const progIDLabel As String = "Forms.Label.1"
 Const progIDFrame As String = "Forms.Frame.1"
 Const progIDButton As String = "Forms.CommandButton.1"
 Const sideValue As Single = 6
 '
 m_form.Font.Name = "Tahoma"
 m_form.Font.Size = 8.25
 m_form.Width = 300
 '
 Set m_info1 = m_form.Controls.Add(progIDLabel)
 CastToControl(m_info1).Move sideValue, sideValue
 TextAlignLabel m_info1, False, True, fmTextAlignLeft
 '
 Set m_info2 = m_form.Controls.Add(progIDLabel)
 CastToControl(m_info2).Move sideValue, CastToControl(m_info1).Top + 12
 TextAlignLabel m_info2, False, True, fmTextAlignLeft
 '
 Set m_barFrame = m_form.Controls.Add(progIDFrame)
 CastToControl(m_barFrame).Move sideValue, CastToControl(m_info2).Top + 15 _
 , m_form.InsideWidth - sideValue * 2, 15
 m_barFrame.SpecialEffect = fmSpecialEffectSunken
 '
 Set m_bar = m_barFrame.Controls.Add(progIDLabel)
 CastToControl(m_bar).Move 0, 0, 15, 15
 m_bar.BackColor = &HC07000
 '
 Set m_elapsed = m_form.Controls.Add(progIDLabel)
 CastToControl(m_elapsed).Move sideValue, CastToControl(m_barFrame).Top + 18
 TextAlignLabel m_elapsed, False, True, fmTextAlignLeft
 '
 Set m_remaining = m_form.Controls.Add(progIDLabel)
 CastToControl(m_remaining).Move sideValue, CastToControl(m_elapsed).Top + 12
 TextAlignLabel m_remaining, False, True, fmTextAlignLeft
 With CastToControl(m_remaining)
 m_form.Height = .Top + .Height + sideValue
 End With
 With m_form
 .Height = .Height * 2 - .InsideHeight
 End With
 '
 Set m_percent = m_form.Controls.Add(progIDLabel)
 CastToControl(m_percent).Move CastToControl(m_barFrame).Width _
 + sideValue - 60, CastToControl(m_elapsed).Top, 60
 TextAlignLabel m_percent, False, False, fmTextAlignRight
 '
 Set m_escButton = m_form.Controls.Add(progIDButton)
 With CastToControl(m_escButton)
 .Cancel = True 'Allows for the form to be closed by pressing the Esc key
 .Move 0, 0, 0, 0
 End With
End Sub
Private Function CastToControl(ByVal c As MSForms.Control) As MSForms.Control
 Set CastToControl = c
End Function
Private Sub TextAlignLabel(ByVal labelControl As MSForms.Label _
 , ByVal wordWrapValue As Boolean _
 , ByVal autoSizeValue As Boolean _
 , ByVal textAlignValue As fmTextAlign)
 With labelControl
 .WordWrap = wordWrapValue
 .AutoSize = autoSizeValue
 .TextAlign = textAlignValue
 End With
End Sub
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Form/Control events
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Sub m_form_Activate()
 If m_showType = vbModal Then RunProcedure
End Sub
Private Sub m_form_QueryClose(Cancel As Integer, CloseMode As Integer)
 If CloseMode = VbQueryClose.vbFormControlMenu Then 'User pressed X button
 Cancel = True
 OnCancel
 End If
End Sub
Private Sub m_escButton_Click()
 OnCancel
End Sub
Private Sub OnCancel()
 If Not m_allowCancel Then Exit Sub
 '
 If MsgBox(Prompt:="Are you sure you want to cancel?" _
 , Buttons:=vbQuestion + vbYesNo _
 , Title:="Please confirm" _
 ) = vbYes Then
 m_form.Hide
 m_cancelled = True
 End If
End Sub
'===============================================================================
'Caption text
'===============================================================================
Public Property Get Caption() As String
 Caption = m_form.Caption
End Property
Public Property Let Caption(ByVal formCaption As String)
 m_form.Caption = formCaption
 Refresh
End Property
'===============================================================================
'Info1 text
'===============================================================================
Public Property Get Info1() As String
 Info1 = m_info1.Caption
End Property
Public Property Let Info1(ByVal info1Label As String)
 m_info1.Caption = info1Label
 Refresh
End Property
'===============================================================================
'Info2 text
'===============================================================================
Public Property Get Info2() As String
 Info2 = m_info2.Caption
End Property
Public Property Let Info2(ByVal info2Label As String)
 m_info2.Caption = info2Label
 Refresh
End Property
'===============================================================================
'Color of the bar
'===============================================================================
Public Property Get BarColor() As Long
 BarColor = m_bar.BackColor
End Property
Public Property Let BarColor(ByVal colorCode As Long)
 m_bar.BackColor = colorCode
 Refresh
End Property
'===============================================================================
'Color of the frame (bar background)
'===============================================================================
Public Property Get BarBackColor() As Long
 BarBackColor = m_barFrame.BackColor
End Property
Public Property Let BarBackColor(ByVal colorCode As Long)
 m_barFrame.BackColor = colorCode
 Refresh
End Property
'===============================================================================
'Enables/disables the X button on the progress form
'===============================================================================
Public Property Get AllowCancel() As Boolean
 AllowCancel = m_allowCancel
End Property
Public Property Let AllowCancel(ByVal canCancel As Boolean)
 m_allowCancel = canCancel
End Property
'===============================================================================
'Can be modal or modeless
'===============================================================================
Public Property Get ShowType() As FormShowConstants
 ShowType = m_showType
End Property
Public Property Let ShowType(ByVal formShowType As FormShowConstants)
 If formShowType <> vbModal Then formShowType = vbModeless 'Restrict value
 m_showType = formShowType
End Property
'===============================================================================
'Enables/disables the time labels
'===============================================================================
Public Property Get ShowTime() As Boolean
 ShowTime = m_showTime
End Property
Public Property Let ShowTime(ByVal displayTime As Boolean)
 m_showTime = displayTime
 m_elapsed.Visible = m_showTime
 m_remaining.Visible = m_showTime
 Refresh
End Property
'===============================================================================
'Indicates if the X button on the progress form was pressed
'===============================================================================
Public Property Get WasCancelled() As Boolean
 WasCancelled = m_cancelled
End Property
'===============================================================================
'Vertical position
'===============================================================================
Public Property Get Top() As Single
 Top = m_form.Top
End Property
Public Property Let Top(ByVal topValue As Single)
 m_form.Top = topValue
 m_isAutoCentered = False
End Property
'===============================================================================
'Horizontal position
'===============================================================================
Public Property Get Left() As Single
 Left = m_form.Left
End Property
Public Property Let Left(ByVal leftValue As Single)
 m_form.Left = leftValue
 m_isAutoCentered = False
End Property
'*******************************************************************************
'Utility for positioning
'*******************************************************************************
Public Sub CenterOnApplication()
 If Application.WindowState = xlMinimized Then Exit Sub
 '
 Dim leftPosition As Single
 Dim topPosition As Single
 '
 With Application
 leftPosition = .Left + (.Width - m_form.Width) / 2
 If leftPosition < .Left Then leftPosition = .Left
 '
 topPosition = .Top + (.Height - m_form.Height) / 2
 If topPosition < .Top Then topPosition = .Top
 End With
 With m_form
 .StartUpPosition = 0
 .Left = leftPosition
 .Top = topPosition
 End With
 m_isAutoCentered = True
End Sub
'===============================================================================
'Size
'===============================================================================
Public Property Get Height() As Single
 Height = m_form.Height
End Property
Public Property Get Width() As Single
 Width = m_form.Width
End Property
Public Property Let Width(ByVal widthValue As Single)
 Const minWidth As Single = 180
 Const maxWidth As Single = 450
 Dim finalWidth As Single: finalWidth = widthValue
 Dim offsetValue As Single
 '
 If finalWidth < minWidth Then finalWidth = minWidth
 If finalWidth > maxWidth Then finalWidth = maxWidth
 If finalWidth = m_form.Width Then Exit Property
 offsetValue = finalWidth - m_form.Width
 '
 m_form.Width = finalWidth
 m_barFrame.Width = m_barFrame.Width + offsetValue
 m_percent.Left = m_percent.Left + offsetValue
 If m_isAutoCentered Then m_form.Left = m_form.Left - offsetValue / 2
End Property
'*******************************************************************************
'Self-instance
'*******************************************************************************
Public Function Self() As ProgressBar
 Set Self = Me
End Function
'===============================================================================
'Current progress value
'===============================================================================
Public Property Get Value() As Double
 Value = m_currentValue
End Property
Public Property Let Value(ByVal percentValue As Double)
 If percentValue < 0 Or percentValue > 1 Then Exit Property
 m_currentValue = percentValue
 '
 m_bar.Width = m_currentValue * m_barFrame.InsideWidth
 m_percent.Caption = "Done: " & Format$(m_currentValue, "0%")
 '
 Refresh
End Property
'*******************************************************************************
'Updates the time and allows for events so that the form is updated visually
'*******************************************************************************
Private Sub Refresh()
 If m_isRunning Then
 UpdateTime
 DoEvents
 End If
End Sub
Private Sub UpdateTime()
 If Not m_showTime Then Exit Sub
 If m_currentValue = 0 Then
 m_elapsed.Caption = vbNullString
 m_remaining.Caption = vbNullString
 Exit Sub
 End If
 '
 Dim elapsedTime As Date
 Dim remainingTime As Date
 '
 elapsedTime = VBA.Now - m_startTime
 remainingTime = elapsedTime / m_currentValue * (1 - m_currentValue)
 '
 UpdateTimeLabel m_elapsed, elapsedTime, "Elapsed time: "
 UpdateTimeLabel m_remaining, remainingTime, "Remaining time: "
End Sub
Private Sub UpdateTimeLabel(ByVal labelControl As MSForms.Label _
 , ByVal timeValue As Date _
 , ByVal prefix As String)
 Dim labelValue As String: labelValue = prefix
 If timeValue > 1 Then labelValue = labelValue & Int(CDbl(timeValue)) & "d "
 labelControl.Caption = labelValue & Format$(timeValue, "hh:mm:ss")
End Sub
'*******************************************************************************
'Runs a macro in a standard module
'*******************************************************************************
Public Function RunMacro(ByVal targetBook As Workbook _
 , ByVal procedure As String _
 , ParamArray args() As Variant) As Variant
 If m_isRunning Then Exit Function
 Dim methodName As String: methodName = TypeName(Me) & ".RunMacro"
 '
 If procedure = vbNullString Then
 Err.Raise 5, methodName, "Invalid procedure name"
 ElseIf targetBook Is Nothing Then
 Err.Raise 91, methodName, "Workbook not set"
 ElseIf UBound(args) >= LBound(args) Then 'Save arguments for async use
 CloneParamArray args(0), UBound(args) + 1, m_args 'ByRef is preserved!
 Else
 m_args = Array()
 End If
 '
 LetSet(RunMacro) = Run(procedure, targetBook, Nothing)
End Function
'*******************************************************************************
'Runs a method of a given object
'*******************************************************************************
Public Function RunObjMethod(ByVal targetObject As Object _
 , ByVal procedure As String _
 , ParamArray args() As Variant) As Variant
 If m_isRunning Then Exit Function
 Dim methodName As String: methodName = TypeName(Me) & ".RunObjMethod"
 '
 If procedure = vbNullString Then
 Err.Raise 5, methodName, "Invalid procedure name"
 ElseIf targetObject Is Nothing Then
 Err.Raise 91, methodName, "Object not set"
 ElseIf UBound(args) >= LBound(args) Then 'Save arguments for async use
 CloneParamArray args(0), UBound(args) + 1, m_args 'ByRef is preserved!
 Else
 m_args = Array()
 End If
 '
 LetSet(RunObjMethod) = Run(procedure, Nothing, targetObject)
End Function
'*******************************************************************************
'Runs a method:
' - in a standard module if 'targetBook' is provided
' - on an object if 'targetObject' is provided
'*******************************************************************************
Private Function Run(ByVal procedure As String _
 , ByVal targetBook As Workbook _
 , ByVal targetObject As Object) As Variant
 m_procedure = procedure
 Set m_targetBook = targetBook
 Set m_targetObj = targetObject
 '
 m_isRunning = True
 m_cancelled = False
 Value = 0
 '
 m_form.Show m_showType
 If m_showType = vbModeless Then
 RunProcedure
 Else 'vbModal. RunProcedure was already executed via Form_Activate event
 End If
 LetSet(Run) = m_result
End Function
'*******************************************************************************
'Utility - assigns a variant to another variant
'*******************************************************************************
Private Property Let LetSet(ByRef result As Variant, ByRef v As Variant)
 If IsObject(v) Then Set result = v Else result = v
End Property
'*******************************************************************************
'Runs the actual method
'*******************************************************************************
Private Sub RunProcedure()
 m_startTime = Now()
 '
 Dim cKey As XlEnableCancelKey: cKey = Application.EnableCancelKey
 If cKey <> xlDisabled Then Application.EnableCancelKey = xlDisabled
 '
 On Error GoTo Clean
 If m_targetObj Is Nothing Then
 RunOnBook
 Else
 #If Mac Then
 RunOnObject m_args
 #Else
 LetSet(m_result) = rtcCallByName(targetObj:=m_targetObj _
 , procNamePtr:=StrPtr(m_procedure) _
 , vCallType:=VbMethod _
 , args:=m_args)
 #End If
 End If
Clean:
 If cKey <> xlDisabled Then Application.EnableCancelKey = cKey
 m_isRunning = False
 If Err.Number = 0 Then
 TryHideForm 'Protection if multiple progress bars are displayed
 Else
 m_form.Hide
 Err.Raise Err.Number, TypeName(Me) & ".RunProcedure"
 End If
End Sub
Private Sub RunOnBook(Optional ByVal Missing As Variant)
 Const maxRunArgs As Long = 30
 Dim argsCount As Long: argsCount = UBound(m_args) + 1
 Dim i As Long
 '
 ReDim Preserve m_args(0 To maxRunArgs - 1)
 For i = argsCount To UBound(m_args)
 m_args(i) = Missing
 Next i
 '
 LetSet(m_result) = Application.Run(FullProcedureName() _
 , m_args(0), m_args(1), m_args(2), m_args(3), m_args(4) _
 , m_args(5), m_args(6), m_args(7), m_args(8), m_args(9) _
 , m_args(10), m_args(11), m_args(12), m_args(13), m_args(14) _
 , m_args(15), m_args(16), m_args(17), m_args(18), m_args(19) _
 , m_args(20), m_args(21), m_args(22), m_args(23), m_args(24) _
 , m_args(25), m_args(26), m_args(27), m_args(28), m_args(29))
End Sub
Private Function FullProcedureName() As String
 FullProcedureName = "'" & m_targetBook.Name & "'!" & m_procedure
End Function
#If Mac Then
Private Sub RunOnObject(ByRef args() As Variant)
 Dim o As Object: Set o = m_targetObj
 Dim p As String: p = m_procedure
 Dim v As VbCallType: v = VbMethod
 '
 Select Case UBound(args) - LBound(args) + 1
 Case 0: LetSet(m_result) = CallByName(o, p, v)
 Case 1: LetSet(m_result) = CallByName(o, p, v, args(0))
 Case 2: LetSet(m_result) = CallByName(o, p, v, args(0), args(1))
 Case 3: LetSet(m_result) = CallByName(o, p, v, args(0), args(1), args(2))
 Case 4: LetSet(m_result) = CallByName(o, p, v, args(0), args(1), args(2), args(3))
 Case 5: LetSet(m_result) = CallByName(o, p, v, args(0), args(1), args(2), args(3), args(4))
 Case 6: LetSet(m_result) = CallByName(o, p, v, args(0), args(1), args(2), args(3), args(4), args(5))
 Case 7: LetSet(m_result) = CallByName(o, p, v, args(0), args(1), args(2), args(3), args(4), args(5), args(6))
 Case 8: LetSet(m_result) = CallByName(o, p, v, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7))
 Case 9: LetSet(m_result) = CallByName(o, p, v, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8))
 Case 10: LetSet(m_result) = CallByName(o, p, v, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9))
 Case 11: LetSet(m_result) = CallByName(o, p, v, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10))
 Case 12: LetSet(m_result) = CallByName(o, p, v, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11))
 Case 13: LetSet(m_result) = CallByName(o, p, v, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12))
 Case 14: LetSet(m_result) = CallByName(o, p, v, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13))
 Case 15: LetSet(m_result) = CallByName(o, p, v, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14))
 Case 16: LetSet(m_result) = CallByName(o, p, v, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15))
 Case 17: LetSet(m_result) = CallByName(o, p, v, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16))
 Case 18: LetSet(m_result) = CallByName(o, p, v, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17))
 Case 19: LetSet(m_result) = CallByName(o, p, v, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18))
 Case 20: LetSet(m_result) = CallByName(o, p, v, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19))
 Case 21: LetSet(m_result) = CallByName(o, p, v, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20))
 Case 22: LetSet(m_result) = CallByName(o, p, v, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20), args(21))
 Case 23: LetSet(m_result) = CallByName(o, p, v, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20), args(21), args(22))
 Case 24: LetSet(m_result) = CallByName(o, p, v, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20), args(21), args(22), args(23))
 Case 25: LetSet(m_result) = CallByName(o, p, v, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20), args(21), args(22), args(23), args(24))
 Case 26: LetSet(m_result) = CallByName(o, p, v, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20), args(21), args(22), args(23), args(24), args(25))
 Case 27: LetSet(m_result) = CallByName(o, p, v, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20), args(21), args(22), args(23), args(24), args(25), args(26))
 Case 28: LetSet(m_result) = CallByName(o, p, v, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20), args(21), args(22), args(23), args(24), args(25), args(26), args(27))
 Case 29: LetSet(m_result) = CallByName(o, p, v, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20), args(21), args(22), args(23), args(24), args(25), args(26), args(27), args(28))
 Case Else: LetSet(m_result) = CallByName(o, p, v, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20), args(21), args(22), args(23), args(24), args(25), args(26), args(27), args(28), args(29))
 End Select
End Sub
#End If

Apologies to those who cannot stand big banners above method definitions. it's just my own preference.

Demo

Assuming a 'worker' code routine in a standard bas module:

Public Function DoWork(ByVal progress As ProgressBar, ByRef stepCount As Long) As Boolean
 Dim i As Long
 For i = 1 To stepCount
 progress.Info2 = "Running " & i & " out of " & stepCount
 progress.Value = i / stepCount
 If progress.WasCancelled Then
 'Clean-up code here
 Exit Function
 End If
 Next
 DoWork = True
End Function

The call to RunMacro can be as simple as:

Public Sub ProgressBarTest()
 With New ProgressBar
 Debug.Print .RunMacro(ThisWorkbook, "DoWork", .Self, 2000)
 End With
End Sub

Or, can be more customized:

Public Sub ProgressBarTest()
 With New ProgressBar
 .Info1 = "Please wait..."
 .AllowCancel = True
 .BarColor = &H4D6A00
 .ShowTime = True
 .ShowType = vbModeless
 Debug.Print .RunMacro(ThisWorkbook, "DoWork", .Self, 2000)
 End With
End Sub

enter image description here

If, we want to call a similar routine in Class1:

Public Function DoWork(ByVal progress As ProgressBar, ByRef stepCount As Long) As Boolean
 Dim i As Long
 For i = 1 To stepCount
 progress.Info2 = "Running " & i & " out of " & stepCount
 progress.Value = i / stepCount
 If progress.WasCancelled Then Exit Function
 Next
 DoWork = True
End Function

then we use the RunObjMethod method:

Public Sub ProgressBarTest()
 With New ProgressBar
 .Info1 = "Please wait..."
 .AllowCancel = True
 .BarColor = &H4D6A00
 .ShowTime = True
 .ShowType = vbModeless
 Debug.Print .RunObjMethod(New Class1, "DoWork", .Self, 2000)
 End With
End Sub

Misc

Here is a list of decisions I took and why:

1. In both the RunMacro and RunObjMethod, the procedure name parameter is after the book/class object parameter so that the variable number of arguments follow nicely after the method name as it would in a regular call. Feels more natural than having the name first
2. I have not fixed the position of the progress bar instance as a parameter for the 'worker' method. It can actually be omitted as an argument entirely but then the 'worker' would not be able to update the bar unless using a global variable - which is bad practice. Just wanted to have full flexibility for the user
3. I did not want to have a global instance of the ProgressBar class that has a factory. I did not consider it to be necessary.
4. When calling Application.Run I've made sure that I pass the maximum number of parameters (30) while making sure that the extra parameters are set to the special value Missing so that I avoid a nasty long Select Case
5. On Windows, instead of calling CallByName I call rtcCallByName (defined on VBE7.dll) which allows me to pass the array of arguments as one argument. On Mac, unfortunately, I had to create a big Select Case (see RunOnObject method). It would be great if someone knows a way to make rtcCallByName work on a Mac or maybe another/better way to achieve the same result
6. Running multiple RunMacro and RunObjMethod on the same instance works without the need to create a new instance. This could be useful when wanting to run consecutive 'workers' with the same options. Example:

Public Sub ProgressBarTest()
 With New ProgressBar
 .Info1 = "Please wait..."
 .AllowCancel = True
 .BarColor = &H4D6A00
 .ShowTime = True
 .ShowType = vbModal
 Debug.Print .RunMacro(ThisWorkbook, "DoWork", .Self, 2000)
 Debug.Print .RunObjMethod(New Class1, "DoWork", .Self, 2000)
 End With
End Sub

7. I did not group the class members into a private type because I wanted to preserve the PascalCase names of the exposed properties while all variables are camelCase. Grouping the members under a UDT makes naming so much more difficult unless you have everything in just PascalCase or just camelCase.

---

Any feedback and suggestions are welcome! Thank you!

---

Any future updates can be found at Excel-VBA-ProgressBar

• Mathieu Guindon: I really like how you've taken my concept and pushed it to the next level, well done! And thanks for the kind words too!
• Energeer: This is a great enhancement, its really useful how its able to run multiple procedures on the same ProgressBar instance. Also good how the Run function can take parameters. With the Reusable Progress Indicator I would refactor my procedure into an object, put the parameters into a factory method and then pass the object to the ProgressIndicator create method: ProgressIndicator.Create("Run", Class1.Create(Param1, Param2))