Reusable Progress Indicator

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 

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