HiveBrain v1.2.0
Get Started
← Back to all entries
patternModerate

A reusable ProgressIndicator

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
reusableprogressindicatorstackoverflow

Problem

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

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 `Predeclared

Solution

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.

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:

Code Snippets

Err.Raise Err.Number, Err.source, Err.Description, Err.HelpFile, Err.HelpContext
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = 0 Then
        Cancel = True
        RaiseEvent Cancelled
    End If
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
Public Event BeforeCancel(ByRef throw As Boolean)
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

Context

StackExchange Code Review Q#87818, answer score: 18

Revisions (0)

No revisions yet.