Reusable Progress Indicator

Question

As many have done on this site, I decided to create a progress indicator using a modeless Userform. However, my goal was to make said progress indicator as generic/reusable as possible.

While doing some research, I stumbled upon @MathieuGuindon's post titled The Reusable Progress Indicator. I quite liked his ideas, so I definitely borrowed a few of them, but instead of writing a predeclared class to interact with the form, I choose to create an interface to expose the Progress Indicator's methods to the client code.

The issue I have currently, is the default instance, (albeit useless without being written against the interface), troubles me, but I fear there is no way around it. Also I am looking for general feedback on my code structure, quality, efficiency, and other improvements that could be made.

Note: I have only been developing in VBA for just over a year. That being said I am on Stack Overflow quite a bit and I am always seeing and learning from, @MathieuGuindon's code, so naturally my coding style has begun to mirror his.

IProgressIndicator (Interface):

Option Explicit
Public Sub UpdateOrphanProgress(ByRef ProgStatusText As Variant, _
 ByRef CurrProgCnt As Long, _
 ByRef TotalProgCnt As Long): End Sub
Public Sub UpdateParentChildProgress(ByRef ParentProgStatusText As Variant, _
 ByRef ParentCurrCnt As Long, _
 ByRef ParentTotalCnt As Long, _
 ByRef ChildProgStatusText As Variant, _
 ByRef ChildCurrProgCnt As Long, _
 ByRef ChildProgCnt As Long, _
 ByRef TotalProgCnt As Long): End Sub
Public Sub LoadProgIndicator(Optional ByVal HasParentProccess As Boolean, _
 Optional ByVal CanCancel As Boolean, _
 Optional ByVal CalculateExecutionTime As Boolean): End Sub
Public Property Get ShouldCancel() As Boolean: End Property

ProgressIndicator Class (Userfrm):

Option Explicit
Implements IProgressIndicator
#If VBA7 Then
 Private Declare PtrSafe Function GetWindowLong _
 Lib "user32" Alias "GetWindowLongA" ( _
 ByVal hwnd As LongPtr, _
 ByVal nIndex As LongPtr) As LongPtr
 Private Declare PtrSafe Function SetWindowLong _
 Lib "user32" Alias "SetWindowLongA" ( _
 ByVal hwnd As LongPtr, _
 ByVal nIndex As LongPtr, _
 ByVal dwNewLong As LongPtr) As LongPtr
 Private Declare PtrSafe Function DrawMenuBar _
 Lib "user32" ( _
 ByVal hwnd As LongPtr) As LongPtr
 Private Declare PtrSafe Function FindWindowA _
 Lib "user32" (ByVal lpClassName As String, _
 ByVal lpWindowName As String) As LongPtr
 Private Declare PtrSafe Function GetTickCount _
 Lib "kernel32.dll" () As LongPtr
#Else
 Private Declare Function GetWindowLong _
 Lib "user32" Alias "GetWindowLongA" ( _
 ByVal hwnd As Long, _
 ByVal nIndex As Long) As Long
 Private Declare Function SetWindowLong _
 Lib "user32" Alias "SetWindowLongA" ( _
 ByVal hwnd As Long, _
 ByVal nIndex As Long, _
 ByVal dwNewLong As Long) As Long
 Private Declare Function DrawMenuBar _
 Lib "user32" ( _
 ByVal hwnd As Long) As Long
 Private Declare Function FindWindowA _
 Lib "user32" (ByVal lpClassName As String, _
 ByVal lpWindowName As String) As Long
 Private Declare Function GetTickCount _
 Lib "kernel32.dll" () As Long
#End If
Private Const GWL_STYLE = -16
Private Const WS_CAPTION = &HC00000
Private Const PROGINDICATOR_MAXHEIGHT As Integer = 142.75
Private Const PARENTPROCSTATUS_MAXHEIGHT As Integer = 10
Private Const PROCSTATUS_MAXTOP As Integer = 16
Private Const PROGRESSBAR_MAXTOP As Integer = 41
Private Const PROGRESSBAR_MAXWIDTH As Integer = 270
Private Const ELAPSEDTIME_MAXTOP As Integer = 83
Private Const TIMEREMAINING_MAXTOP As Integer = 94
Private Const STARTPOS_LEFT_OFFSET As Single = 0.5
Private Const STARTPOS_RIGHT_OFFSET As Single = 0.5
Private Const ERR_ORPHANPROC_NOPARENT As String = "You specified that this proccess has a parent, " & _
 "but you are using the 'UpdateOrphanProgress' method"
Private Const ERR_HASPARENT_NOTSPECIFIED As String = "You specified that this proccess does not have a parent, " & _
 "but you are using the 'UpdateParentChildProgress' method."
Private Const ERR_INVALIDPROGPERCENT As String = "Either the CurrProgCnt equals 0, is greater than 0, or it " & _
 "is greater than TotalProgCnt."
Private Const ERR_INVALIDPARENTCOUNT As String = "Either the ParentCurrCnt equals 0, is greater than 0, or it " & _
 "is greater than ParentTotalCnt."
Public Enum ProgressIndicatorError 
 Error_OrphanProcHasParent = vbObjectError + 1001
 Error_HasParentProcNotSpecified
 Error_InvalidProgressPercentage
 Error_InvalidParentCount
End Enum
Private Type TProgressIndicator
 StartTime As Double
 TimeElapsed As Double
 SecondsElapsed As Double
 MinutesElapsed As Double
 HoursElapsed As Double
 SecondsRemaining As Double
 MinutesRemaining As Double
 HoursRemaining As Double
 ItemsRemaining As Double
 ParentChildIterationCount As Long
 HasParentProccess As Boolean
 CanCancel As Boolean
 Cancelling As Boolean
 CalculateExecutionTime As Boolean
 PercentComplete As Double
End Type
Private this As TProgressIndicator
'*****************************************************************************
'Properties
'*****************************************************************************
Private Property Get HasParentProccess() As Boolean
 HasParentProccess = this.HasParentProccess
End Property
Private Property Get Cancellable() As Boolean
 Cancellable = this.CanCancel
End Property
Private Property Get IsCancelRequested() As Boolean
 IsCancelRequested = this.Cancelling
End Property
Private Property Get CalculateExecutionTime() As Boolean
 CalculateExecutionTime = this.CalculateExecutionTime
End Property
'*****************************************************************************
'Methods
 '***************************************************************************** 
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
 If CloseMode = 0 Then
 Cancel = True
 If Cancellable Then this.Cancelling = True
 End If
End Sub
Private Property Get IProgressIndicator_ShouldCancel() As Boolean
 If IsCancelRequested Then
 If MsgBox("Would you like to Cancel this operation?", _
 vbQuestion + vbYesNo, "Process Dialog") = vbYes Then
 IProgressIndicator_ShouldCancel = True
 Me.Hide
 Else
 this.Cancelling = False
 End If
 End If
End Property
Private Sub IProgressIndicator_LoadProgIndicator(Optional ByVal HasParentProccess As Boolean, _
 Optional ByVal CanCancel As Boolean, _
 Optional ByVal CalculateExecutionTime As Boolean)
 this.CalculateExecutionTime = CalculateExecutionTime
 If CalculateExecutionTime Then this.StartTime = GetTickCount()
 HideTitleBar
 this.HasParentProccess = HasParentProccess: this.CanCancel = CanCancel
 With Me
 If this.HasParentProccess Then
 .Height = PROGINDICATOR_MAXHEIGHT
 .ParentProcedureStatus.Height = PARENTPROCSTATUS_MAXHEIGHT
 .ProcedureStatus.Top = PROCSTATUS_MAXTOP
 .frameProgressBar.Top = PROGRESSBAR_MAXTOP
 .lblElapsedTime.Top = ELAPSEDTIME_MAXTOP
 .ElapsedTime.Top = ELAPSEDTIME_MAXTOP
 .lblTimeRemaining.Top = TIMEREMAINING_MAXTOP
 .TimeRemaining.Top = TIMEREMAINING_MAXTOP
 End If
 .ProgressBar.Width = 0
 .StartUpPosition = 0
 .Left = Application.Left + (STARTPOS_LEFT_OFFSET * Application.Width) - (STARTPOS_LEFT_OFFSET * .Width)
 .Top = Application.Top + (STARTPOS_RIGHT_OFFSET * Application.Height) - (STARTPOS_RIGHT_OFFSET * .Height)
 .Show
 End With
End Sub
Private Sub HideTitleBar()
 Dim lngWindow As Long, lngFrmHdl As Long
 lngFrmHdl = FindWindowA(vbNullString, Me.Caption)
 lngWindow = GetWindowLong(lngFrmHdl, GWL_STYLE)
 lngWindow = lngWindow And (Not WS_CAPTION)
 Call SetWindowLong(lngFrmHdl, GWL_STYLE, lngWindow)
 Call DrawMenuBar(lngFrmHdl)
End Sub
Private Sub IProgressIndicator_UpdateOrphanProgress(ByRef ProgStatusText As Variant, _
 ByRef CurrProgCnt As Long, _
 ByRef TotalProgCnt As Long)
 ThrowIfOrphanProcHasParent
 ThrowIfInvalidProgPercent CurrProgCnt, TotalProgCnt
 this.PercentComplete = CurrProgCnt / TotalProgCnt
 With Me
 .ProcedureStatus.Caption = ProgStatusText & " " & _
 CurrProgCnt & " of " & TotalProgCnt
 .ProgressBar.Width = this.PercentComplete * PROGRESSBAR_MAXWIDTH
 End With
 If CalculateExecutionTime Then CalculateTime CurrProgCnt, TotalProgCnt
 DoEvents
 If CurrProgCnt = TotalProgCnt Then Me.Hide 'Unload Me ??
End Sub
Private Sub IProgressIndicator_UpdateParentChildProgress(ByRef ParentProgStatusText As Variant, _
 ByRef ParentCurrCnt As Long, _
 ByRef ParentTotalCnt As Long, _
 ByRef ChildProgStatusText As Variant, _
 ByRef ChildCurrProgCnt As Long, _
 ByRef ChildProgCnt As Long, _
 ByRef TotalProgCnt As Long)
 ThrowIfHasParentNotSpecified
 ThrowIfInvalidParentCount ParentCurrCnt, ParentTotalCnt
 ThrowIfInvalidProgPercent ChildCurrProgCnt, ChildProgCnt
 this.ParentChildIterationCount = this.ParentChildIterationCount + 1
 this.PercentComplete = ChildCurrProgCnt / ChildProgCnt
 With Me
 .ParentProcedureStatus.Caption = ParentProgStatusText & " " & _
 ParentCurrCnt & " of " & ParentTotalCnt
 .ProcedureStatus.Caption = ChildProgStatusText & " " & _
 ChildCurrProgCnt & " of " & ChildProgCnt
 .ProgressBar.Width = this.PercentComplete * PROGRESSBAR_MAXWIDTH
 End With
 If CalculateExecutionTime Then CalculateTime this.ParentChildIterationCount, TotalProgCnt
 DoEvents
 If ParentCurrCnt = ParentTotalCnt Then
 If ChildCurrProgCnt = ChildProgCnt Then Me.Hide 'Unload Me ??
 End If
End Sub
'*****************************************************************************
'Time Calulations
'*****************************************************************************
Private Sub CalculateTime(ByRef CurrProgCntIn As Long, ByRef TotalProgCntIn As Long)
 With this
 If CurrProgCntIn = TotalProgCntIn Then
 Me.ElapsedTime.Caption = "" & .HoursElapsed & " hours, " & _
 .MinutesElapsed & " minutes, " & .SecondsElapsed & " seconds"
 Me.TimeRemaining.Caption = "" & 0 & " hours, " & 0 & _
 " minutes, " & 0 & " seconds"
 Else
 .TimeElapsed = (GetTickCount() - this.StartTime)
 .SecondsElapsed = .TimeElapsed / 1000
 .MinutesElapsed = RoundTime(.TimeElapsed, 60000)
 .HoursElapsed = RoundTime(.TimeElapsed, 3600000)
 .ItemsRemaining = TotalProgCntIn - CurrProgCntIn
 .SecondsRemaining = (.SecondsElapsed * (TotalProgCntIn / CurrProgCntIn)) - .SecondsElapsed
 .MinutesElapsed = RoundTime(.SecondsRemaining, 60)
 .HoursElapsed = RoundTime(.SecondsRemaining, 60)
 Me.ElapsedTime.Caption = "" & .HoursElapsed & " hours, " & _
 .MinutesElapsed & " minutes, " & .SecondsElapsed & " seconds"
 Me.TimeRemaining.Caption = "" & .HoursRemaining & " hours, " & .MinutesRemaining & _
 " minutes, " & .SecondsRemaining & " seconds"
 End If
 End With
End Sub
Private Function RoundTime(ByRef TimeElapsedIn As Double, ByVal IntervalIn As Long) As Double
 RoundTime = Int(TimeElapsedIn / IntervalIn)
End Function
'*****************************************************************************
'Error Checking Procedures
'*****************************************************************************
Private Sub ThrowIfOrphanProcHasParent()
 If HasParentProccess Then
 Beep
 Err.Raise ProgressIndicatorError.Error_OrphanProcHasParent, _
 TypeName(Me), ERR_ORPHANPROC_NOPARENT
 End If
End Sub
Private Sub ThrowIfHasParentNotSpecified()
 If Not HasParentProccess Then
 Beep
 Err.Raise ProgressIndicatorError.Error_HasParentProcNotSpecified, _
 TypeName(Me), ERR_HASPARENT_NOTSPECIFIED
 End If
End Sub
Private Sub ThrowIfInvalidProgPercent(ByRef CurrProgCntIn As Long, ByRef TotalProgCntIn As Long)
 If Not (CurrProgCntIn > 0 And CurrProgCntIn <= TotalProgCntIn) Then
 Beep
 Err.Raise ProgressIndicatorError.Error_InvalidProgressPercentage, _
 TypeName(Me), ERR_INVALIDPROGPERCENT
 End If
End Sub
Private Sub ThrowIfInvalidParentCount(ByRef ParentCurrCntIn As Long, ByRef ParentTotalCntIn As Long)
 If Not (ParentCurrCntIn > 0 And ParentCurrCntIn <= ParentTotalCntIn) Then
 Beep
 Err.Raise ProgressIndicatorError.Error_InvalidParentCount, _
 TypeName(Me), ERR_INVALIDPARENTCOUNT
 End If
End Sub

Tests:

Public Sub TestingOrphanProccess()
 Dim i As Long
 Dim ProgressBar As IProgressIndicator
 On Error GoTo ErrHandle
 Set ProgressBar = New ProgressIndicator
 ProgressBar.LoadProgIndicator CanCancel:=True, CalculateExecutionTime:=True
 For i = 1 To 10000
 'only have to specify this property if boolCanCancel:=True
 If ProgressBar.ShouldCancel Then Exit Sub
 Sheet1.Cells(1, 1) = i
 ProgressBar.UpdateOrphanProgress "Proccessing", i, 10000
 Next
 Exit Sub
ErrHandle:
 Debug.Print Err.Number
End Sub

enter image description here

enter image description here

Sub TestingParentChildProccess()
 Dim ProgressBar As IProgressIndicator
 Dim dict As Object
 Dim arryTotalItemCnt() As Variant, arryTemp As Variant
 Dim lngMaxItems As Long
 Dim varKey As Variant
 Dim lngParentCntr As Long, i As Long
 Set ProgressBar = New ProgressIndicator
 ProgressBar.LoadProgIndicator HasParentProccess:=True, CanCancel:=True, CalculateExecutionTime:=True
 Set dict = CreateObject("Scripting.Dictionary")
 dict("Key1") = Array(1, 2, 3)
 ReDim Preserve arryTotalItemCnt(UBound(dict("Key1")) + 1)
 dict("Key2") = Array(1, 2, 3, 4)
 ReDim Preserve arryTotalItemCnt(UBound(arryTotalItemCnt) + UBound(dict("Key2")) + 1)
 dict("Key3") = Array(1, 2, 3, 4, 5)
 ReDim Preserve arryTotalItemCnt(UBound(arryTotalItemCnt) + UBound(dict("Key3")) + 1)
 lngMaxItems = UBound(arryTotalItemCnt)
 For Each varKey In dict
 lngParentCntr = lngParentCntr + 1
 arryTemp = dict.Item(varKey)
 For i = 0 To UBound(arryTemp)
 ProgressBar.UpdateParentChildProgress "Proccessing Parent", lngParentCntr, dict.Count, _
 "Processing Child", i + 1, UBound(arryTemp) + 1, lngMaxItems
 Application.Wait (Now() + TimeValue("00:00:01"))
 Next i
 Next
End Sub

enter image description here

• Mathieu Guindon: That looks great, I hope I find the time to review it! Couple questions: Why are all these parameters ByRef, why the explicit Call keyword in only two out of [didn't count, ...many, many, many] call statements? You might have missed this recent SO answer ;-) lastly, the indentation feels inconsistent in a few places, are you using an indenter?
• Mathieu Guindon: Linking the original progress indicator post, for context
• ARickman: @MathieuGuindon I hope so to for my sake, lol! I chose ByRef because I figured that passing ByVal would be slower for when using the progress indicator for long running processes. That could very well be a naive assumption, but that's why I did it. As for Call in the HideTitleBar sub, I originally had the Call key word for all the sub procedures, as I prefer to do so to explicitly denote the use of a Sub, but I thought it looked clutered in my class, so I got rid of it, but obviously I missed the two in HideTitleBar. And I am not using an indenter, but I probably should, lol.
• AJD: Don't have time to review at the moment - but a quick UI comment. If you are using the form to allow the user to cancel the operation (which is a good idea in my opinion), then including the Cancel button on the form itself is a better UI design choice.
• AJD: Oh, and having the name of the process is certainly important just in case you have more than one progress bar up!