Прилагаемые процедуры VBA предназначены для пользовательской формы индикатора выполнения. Все работает, как и ожидалось, за исключением того, что кнопка отмены периодически не отвечает.
Я говорю с перебоями, потому что в 95% случаев мне приходится нажимать кнопку отмены несколько раз, прежде чем процедура останавливается. Я вижу, что событие нажатия кнопки анимируется, но процедура не прерывается. Похоже, что-то крадет фокус у кнопки отмены, прежде чем может произойти событие нажатия кнопки.
Кнопки выхода и закрытия окна реагируют, как и ожидалось, одним щелчком мыши.
Что мне нужно сделать, чтобы кнопка отмены реагировала правильно? Спасибо!
Обновление : я заметил, что когда я нажимаю и удерживаю кнопку отмены, вместо кнопки, удерживающей кнопку «вниз», она поднимается обратно. Так что, очевидно, что-то сбрасывает состояние кнопки вверх, достаточно быстро, чтобы процедура не перехватывала состояние выключения для запуска события click.
Вот код в модуле пользовательской формы (с именем 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
Вот код для модуля (названного Module1), который вызывает 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