patternModerate
A reusable ProgressIndicator
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
I kept it simple, but flexible enough to allow the
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
@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 SubClass: 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:
Per MSDN,
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,
Magic Constants
Other than the hard-coded error numbers mentioned in @Snowbody's answer...
...
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!
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
So you add a
And you raise it before the nuke goes off, to allow the client code to set
Then the client code can have a
And deal with the
And now the "DoWork" code can periodically evaluate the
...resulting in a clean cancellation:
Re-raising errors
This is rather ugly:
Err.Raise Err.Number, Err.source, Err.Description, Err.HelpFile, Err.HelpContextPer 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 SubRaising 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 SubThen 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 BooleanAnd 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 SubAnd 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.HelpContextPrivate Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then
Cancel = True
RaiseEvent Cancelled
End If
End SubPrivate 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 SubPublic 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 SubContext
StackExchange Code Review Q#87818, answer score: 18
Revisions (0)
No revisions yet.