A reusable ProgressIndicator

Question

There was a Tweet from @ExcelEasy earlier this week, that linked to this article, to which I replied with a little challenge:

@ExcelEasy well done! #Challenge: make a more #OOP one without using the form's default/global instance! #becausewhynot

Of course I wouldn't just leave it at that, so here's my own implementation:

---

UserForm: ProgressView

ProgressView showing 41.1% completed

The form itself isn't responsible for anything other than updating itself and notifying the ProgressIndicator when it's ready to start reporting progress, or when the user clicked the red "X" button to cancel the action in progress.

I kept it simple, but flexible enough to allow the ProgressIndicator and its client code change its caption and label as needed.

Option Explicit
Private Const PROGRESSBAR_MAXWIDTH As Integer = 224
Public Event Activated()
Public Event Cancelled()
Private Sub UserForm_Activate()
 ProgressBar.Width = 0 ' it's set to 10 to be visible at design-time
 RaiseEvent Activated
End Sub
Public Sub Update(ByVal percentValue As Single, Optional ByVal labelValue As String, Optional ByVal captionValue As String)
 
 If labelValue <> vbNullString Then
 ProgressLabel.Caption = labelValue
 End If
 
 If captionValue <> vbNullString Then
 Me.Caption = captionValue
 End If
 
 ProgressBar.Width = percentValue * PROGRESSBAR_MAXWIDTH
 DoEvents
 
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
 If CloseMode = 0 Then
 Cancel = True
 RaiseEvent Cancelled
 End If
End Sub

---

Class: ProgressIndicator

That's where the logic is. I've set it up with reasonable defaults, so that it's usable with minimal configuration. I'm including the actual text file, because this class (and the form) is meant to be defined in an Excel add-in (.xlam), so that it's available to every VBA project; as such, it's Public, not creatable, which makes it impossible to instantiate from client code - that's why I've set the PredeclaredId attribute to True and included a factory method:

VERSION 1.0 CLASS
BEGIN
 MultiUse = -1 'True
END
Attribute VB_Name = "ProgressIndicator"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const DEFAULT_CAPTION As String = "Progress"
Private Const DEFAULT_LABEL As String = "Please wait..."
Private Const ERR_NOT_INITIALIZED As String = "ProgressIndicator is not initialized."
Private Const ERR_PROC_NOT_FOUND As String = "Specified macro or object member was not found."
Private Const ERR_OPERATION_CANCELLED As String = "Operation was cancelled by the user."
Public Enum ProgressIndicatorError
 Error_NotInitialized = vbObjectError + 1001
 Error_ProcedureNotFound
 Error_OperationCancelled
End Enum
Private Type TProgressIndicator
 procedure As String
 instance As Object
 sleepDelay As Long
End Type
Private this As TProgressIndicator
Private WithEvents view As ProgressView
Attribute view.VB_VarHelpID = -1
Private Sub Class_Initialize()
 Set view = New ProgressView
 view.Caption = DEFAULT_CAPTION
 view.ProgressLabel = DEFAULT_LABEL
End Sub
Private Sub Class_Terminate()
 Set view = Nothing
 Set this.instance = Nothing
End Sub
Private Function QualifyMacroName(ByVal book As Workbook, ByVal procedure As String) As String
 QualifyMacroName = "'" & book.FullName & "'!" & procedure
End Function
Public Function Create(ByVal procedure As String, Optional instance As Object = Nothing, Optional ByVal initialLabelValue As String, Optional ByVal initialCaptionValue As String, Optional ByVal completedSleepMilliseconds As Long = 1000) As ProgressIndicator
 
 Dim result As New ProgressIndicator
 
 result.SleepMilliseconds = completedSleepMilliseconds
 
 If Not instance Is Nothing Then
 Set result.OwnerInstance = instance
 ElseIf Not Framework.Strings.Contains(procedure, "'!") Then
 procedure = QualifyMacroName(Application.ActiveWorkbook, procedure)
 End If
 
 result.ProcedureName = procedure
 
 If initialLabelValue <> vbNullString Then
 result.ProgressView.ProgressLabel = initialLabelValue
 End If
 
 If initialCaptionValue <> vbNullString Then
 result.ProgressView.Caption = initialCaptionValue
 End If
 
 Set Create = result
 
End Function
Friend Property Get ProgressView() As ProgressView
 Set ProgressView = view
End Property
Friend Property Get ProcedureName() As String
 ProcedureName = this.procedure
End Property
Friend Property Let ProcedureName(ByVal value As String)
 this.procedure = value
End Property
Friend Property Get OwnerInstance() As Object
 Set OwnerInstance = this.instance
End Property
Friend Property Set OwnerInstance(ByVal value As Object)
 Set this.instance = value
End Property
Friend Property Get SleepMilliseconds() As Long
 SleepMilliseconds = this.sleepDelay
End Property
Friend Property Let SleepMilliseconds(ByVal value As Long)
 this.sleepDelay = value
End Property
Public Sub Execute()
 view.Show vbModal
End Sub
Public Sub Update(ByVal percentValue As Single, Optional ByVal labelValue As String, Optional ByVal captionValue As String)
 On Error GoTo CleanFail
 ThrowIfNotInitialized
 ValidatePercentValue percentValue
 view.Update percentValue, labelValue
CleanExit:
 If percentValue = 1 Then Sleep this.sleepDelay
 Exit Sub
CleanFail:
 MsgBox Err.Number & vbTab & Err.Description, vbCritical, "Error"
 Resume CleanExit
End Sub
Public Sub UpdatePercent(ByVal percentValue As Single, Optional ByVal captionValue As String)
 ValidatePercentValue percentValue
 Update percentValue, Format(percentValue, "0.0% Completed")
End Sub
Private Sub ValidatePercentValue(ByRef percentValue As Single)
 If percentValue > 1 Then
 percentValue = percentValue / 100
 End If
End Sub
Private Sub ThrowIfNotInitialized()
 If this.procedure = vbNullString Then
 Err.Raise ProgressIndicatorError.Error_NotInitialized, TypeName(Me), ERR_NOT_INITIALIZED
 End If
End Sub
Private Sub view_Activated()
 On Error GoTo CleanFail
 ThrowIfNotInitialized
 If Not this.instance Is Nothing Then
 ExecuteInstanceMethod
 Else
 ExecuteMacro
 End If
CleanExit:
 view.Hide
 Exit Sub
CleanFail:
 MsgBox Err.Number & vbTab & Err.Description, vbCritical, "Error"
 Resume CleanExit
End Sub
Private Sub ExecuteMacro()
 On Error GoTo CleanFail
 Application.Run this.procedure, Me
CleanExit:
 Exit Sub
CleanFail:
 If Err.Number = 438 Then
 Err.Raise ProgressIndicatorError.Error_ProcedureNotFound, TypeName(Me), ERR_PROC_NOT_FOUND
 Else
 Err.Raise Err.Number, Err.source, Err.Description, Err.HelpFile, Err.HelpContext
 End If
 Resume CleanExit
End Sub
Private Sub ExecuteInstanceMethod()
 On Error GoTo CleanFail
 Dim parameter As ProgressIndicator
 Set parameter = Me 'Me cannot be passed to CallByName directly
 CallByName this.instance, this.procedure, VbMethod, parameter
CleanExit:
 Exit Sub
CleanFail:
 If Err.Number = 438 Then
 Err.Raise ProgressIndicatorError.Error_ProcedureNotFound, TypeName(Me), ERR_PROC_NOT_FOUND
 Else
 Err.Raise Err.Number, Err.source, Err.Description, Err.HelpFile, Err.HelpContext
 End If
 Resume CleanExit
End Sub
Private Sub view_Cancelled()
 'this error isn't trappable, but not raising it wouldn't cancel anything:
 Err.Raise ProgressIndicatorError.Error_OperationCancelled, TypeName(Me), ERR_OPERATION_CANCELLED
End Sub

One thing I don't like, is that UpdatePercent will validate the percentValue parameter twice. Another thing I don't like, is that ValidatePercentValue has side-effects and should really be a Function that returns a Boolean... or it should have a different name, but I'm not sure what.

---

Client Code

The client code is in two parts; the first is responsible for instantiating the ProgressIndicator and specifying what procedure will do the work. Typically that would be a parameterless macro procedure attached to an ActiveX or Forms button on a worksheet:

Public Sub DoSomething()
 With ProgressIndicator.Create("DoWork")
 .Execute
 End With
End Sub

The "DoWork" procedure can be any Public Sub located in a standard or class module, taking a ProgressIndicator parameter - here it's a macro procedure in a standard module. I could have specified an instance parameter to make it work off a member procedure, too.

All that procedure needs to care about, is the work it's responsible for; when it needs to report progress, it can do so by calling the Update or UpdatePercent method on the progress parameter:

Public Sub DoWork(ByVal progress As ProgressIndicator)
 
 Dim i As Long
 For i = 1 To 1000
 Cells(1, 1) = i
 progress.UpdatePercent i / 1000
 Next
 
End Sub

Any oversight?

---

I'm using a Framework.Strings.Contains function in the ProgressIndicator class - as I said this code lives in an Excel add-in that has plenty of other useful tools; here's the function in question, for completeness:

Public Function Contains(ByVal string_source As String, ByVal find_text As String, Optional ByVal caseSensitive As Boolean = False) As Boolean
 
 Dim compareMethod As VbCompareMethod
 
 If caseSensitive Then
 compareMethod = vbBinaryCompare
 Else
 compareMethod = vbTextCompare
 End If
 
 Contains = (InStr(1, string_source, find_text, compareMethod) <> 0)
 
End Function

• Mathieu Guindon: If anyone is interested, I've uploaded this code to my VBTools repository on GitHub.

Answer 1

There are a number of (minor) issues here.

Re-raising errors

This is rather ugly:

Err.Raise Err.Number, Err.source, Err.Description, Err.HelpFile, Err.HelpContext

Per MSDN, Err.Raise can "rethrow" an error much cleaner than that:

All of the Raise arguments except Number are optional. If you omit optional arguments, and the property settings of the Err object contain values that have not been cleared, those values serve as the values for your error.

This means the above can be shortened to, Err.Raise Err.Number.

---

Magic Constants

Other than the hard-coded error numbers mentioned in @Snowbody's answer...

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
 If CloseMode = 0 Then
 Cancel = True
 RaiseEvent Cancelled
 End If
End Sub

...0 is a magic value in CloseMode = 0; the VBA standard library defines the vbQueryClose enum for that purpose - replacing value 0 with vbQueryClose.vbFormControlMenu makes it much clearer that the condition is evaluating whether the CloseMode is related to the user clicking the red "X" in the form's control box.

---

Cancellation

This is totally unacceptable UX - this error will bring up a VBA debugger window prompting the user to End execution or Debug the code... which makes it a feature that feels like a bug!

Private Sub view_Cancelled()
 'this error isn't trappable, but not raising it wouldn't cancel anything:
 Err.Raise ProgressIndicatorError.Error_OperationCancelled, TypeName(Me), ERR_OPERATION_CANCELLED
End Sub

Raising an untrappable error doesn't cancel the task in progress, it nukes it.

nuke

You have already cancelled the form's closing; all you need to do is to forbid the cancellation of the task in progress... unless the client code has an explicit way of handling cancellation - and you can let the client code know the user intends to cancel the task, by raising an event.

I would add a canCancel member to this, which would only be True when the "DoWork" code is located in a class module (i.e. when the ProgressIndicator instance can be a Private WithEvents field) - then you can leave it up to the client code to decide whether they want to nuke the long-running process, or handle it cleanly.

So you add a BeforeCancel event to the ProgressIndicator:

Public Event BeforeCancel(ByRef throw As Boolean)

And you raise it before the nuke goes off, to allow the client code to set throw to False and deal with cleanly cancelling the task:

Private Sub view_Cancelled()
 If Not this.canCancel Then Exit Sub
 Dim throw As Boolean
 throw = True
 RaiseEvent BeforeCancel(throw)
 'this error isn't trappable, but not raising it wouldn't cancel anything:
 If throw Then OnCancelledError
End Sub

Then the client code can have a Boolean flag to capture the cancelling state of the progress indicator:

Private WithEvents indicator As ProgressIndicator
Private isCancelling As Boolean

And deal with the BeforeCancel event like this:

Private Sub indicator_BeforeCancel(throw As Boolean)
 isCancelling = True
 throw = False
End Sub
Private Sub OnProgressCancelled()
 Err.Raise ProgressIndicatorError.Error_OperationCancelled, TypeName(Me), "Operation was cancelled."
End Sub

And now the "DoWork" code can periodically evaluate the isCancelling flag, and act accordingly:

For Each record In data
 If isCancelling Then OnProgressCancelled
 ...

...resulting in a clean cancellation:

operation was cancelled. 0/6 transactions committed.

• findwindow: lol +1 just for nuke graphic^^

Answer 2

Update percentValue, Format(percentValue, "0.0% Completed")

Maybe make the format string settable, in case the code is used in a different language, or one which uses a different character as the integer-fraction separator.

 percentValue = percentValue / 100

Isn't * .01 faster?

What's the magic number 438? It's there twice, can you make it a Const at least?

Seriously, this is very good code, that's the reason you're not getting much attention, there's not much to suggest!

• Mathieu Guindon: Runtime error 438 is Object does not support property or method, raised if we try calling DoSomething on an object that doesn't have such a member.
• RubberDuck: You don't have a module that defines all of the built in runtime errors yet?
• Mathieu Guindon: @RubberDuck I... don't have that... yet.
• R3uK: @RubberDuck : That's interesting indeed, can you share it with us somehow, pretty please? o:)
• RubberDuck: Yeah. I don't see why not @R3uK. I'll add it to the VBEX repo sometime next week. So, you can watch that repo for it. I thought it was already in there, but I'll need to add it I guess. github.com/ckuhn203/VBEX

Answer 3

Create an IProgress interface, and have your class implement the interface. Then the interface can be reimplemented by Access forms that do the same thing, or by classes that encapsulate the application's own status bar progress indicator, or any other class that wants to show progress using DrawRectangle, or the ribbon, or Excel cells, or Excel charts, or an InternetExplorer window, or ASCII art or whatever.

Then any routine that currently accepts a ProgressIndicator would change to accept any class that implements an IProgress interface.

The interface only exposes the properties and methods that make it usable, and the interface abstracts away any dependency on Excel.

Any class that consumes an IProgress can then run 'silently' without any problems, where IProgess won't actually implement progress.

• RubberDuck: Great advice, but you should know that you can use UserForms in Access too! =)
• ThunderFrame: Indeed you can, but the VBIDE under Access makes it hard to add them. You can add them from an import, or by adding a button to the Toolbars... Just don't try dragging a VBForm from an Excel project to an Access project, or you'll get unpredictable results.
• ThunderFrame: There are merits to using VB forms in Access, particularly for a Progress Bar, but sometimes you'll want the data-binding and/or sub-forms that Access forms offer.
• RubberDuck: No doubt! Just pointing it out.