The attached VBA procedures are for a progress bar userform. Everything works as expected, except that the cancel button is intermittently unresponsive.
I say intermittently because, 95% of the time I have to click the cancel button numerous times before the procedure stops. I can see the button click event being animated, but the procedure isn't being interrupted. It looks as though something is stealing focus from the cancel button before the button down event can occur.
The escape and window close buttons respond as expected with one click.
What do I need to do to make the cancel button respond correctly? Thanks!
Update: I noticed that when I click and hold down on the cancel button, instead of the button staying "down" it gets kicked back up. So apparently something is resetting the button state to up, fast enough that the procedure is not catching the down state to fire the click event.
Here is the code in the userform module (named UserForm1):
Private mbooUserCancel As Boolean
Public Property Get UserCancel() As Boolean
UserCancel = mbooUserCancel
End Property
Private Property Let UserCancel(ByVal booUserCancel As Boolean)
mbooUserCancel = booUserCancel
End Property
Public Sub UpdateProgress(CountTotal As Long, CountProgress As Long)
On Error GoTo Error_Handler
ProgressBar1.Value = CountProgress / CountTotal * 100
DoEvents
Error_Handler:
If Err.Number = 18 Then CommandButton1_Click
End Sub
Private Sub CommandButton1_Click()
Hide
UserCancel = True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Cancel = True
CommandButton1_Click
End Sub
Private Sub UserForm_Activate()
With Application
.Interactive = False
.EnableCancelKey = xlErrorHandler
End With
End Sub
Private Sub UserForm_Terminate()
Application.Interactive = True
End Sub
Here is the code for the module (named Module1) that calls the UserForm1:
Sub TestProgress()
On Error GoTo Error_Handler
Dim objUserForm As New UserForm1
Dim lngCounter As Long
Dim lngSubCounter As Long
With objUserForm
.Show vbModeless
DoEvents
For lngCounter = 1 To 5
If .UserCancel Then GoTo Exit_Sub
For lngSubCounter = 1 To 100000000
Next lngSubCounter
.UpdateProgress 5, lngCounter
Next lngCounter
Application.Wait Now + TimeValue("0:00:02")
.Hide
End With
Exit_Sub:
If objUserForm.UserCancel Then
MsgBox "User Cancelled from UserForm1"
End If
Exit Sub
Error_Handler:
If Err.Number = 18 Then
Unload objUserForm
MsgBox "User Cancelled from Module1"
End If
End Sub