Да, это возможно.Используйте DoEvents
, чтобы указать VBA продолжать прокачивать / обрабатывать сообщения Windows;результат может быть не таким отзывчивым, как мог бы быть действительно асинхронный код, но этого должно быть достаточно для включения нажатия кнопки [Отмена] и отмены процесса.
Код в этой статье (заявление об отказе: я написал его) изначально был написан для Excel и использует UserForm
(который скрыт в VBE, когда хостом является Access, но проекты Access VBA могут абсолютно содержать и потреблять UserForm
модулей).
Вы захотите удалить специфичные для Excel биты, например, QualifyMacroName
здесь:
Private Function QualifyMacroName(ByVal book As Workbook, ByVal procedure As String) As String
QualifyMacroName = "'" & book.FullName & "'!" & procedure
End Function
, а затем изменить фабричный метод Create
на требуют instance
параметр, такой как:
Public Function Create(ByVal procedure As String, ByVal instance As Object, Optional ByVal initialLabelValue As String, Optional ByVal initialCaptionValue As String, Optional ByVal completedSleepMilliseconds As Long = 1000, Optional canCancel As Boolean = False) As ProgressIndicator
Dim result As ProgressIndicator
Set result = New ProgressIndicator
result.Cancellable = canCancel
result.SleepMilliseconds = completedSleepMilliseconds
If Not instance Is Nothing Then
Set result.OwnerInstance = instance
Else
Err.Raise 5, TypeName(Me), "Invalid argument: 'instance' must be a valid object reference."
End If
result.ProcedureName = procedure
If initialLabelValue <> vbNullString Then result.ProgressView.ProgressLabel = initialLabelValue
If initialCaptionValue <> vbNullString Then result.ProgressView.Caption = initialCaptionValue
Set Create = result
End Function
После его компиляции вы можете использовать ProgressIndicator
, зарегистрировав рабочий метод, который выполняет фактическую работу, например:
With ProgressIndicator.Create("Run", New MyLongRunningMacro, canCancel:=True)
.Execute
End With
Где MyLongRunningMacro
- это модуль класса с методом Run
, который может выглядеть примерно так:
Public Sub Run(ByVal progress As ProgressIndicator)
Dim thingsDone As Long
For Each thing In ThingsToDo
Application.Run thing
thingsDone = thingsDone + 1
progress.UpdatePercent thingsDone / ThingsToDo.Count
If ShouldCancel(progress) Then
' user confirmed they want to cancel the whole thing.
' perform any clean-up or rollback here
Exit Sub
End If
Next
End Sub
Private Function ShouldCancel(ByVal progress As ProgressIndicator) As Boolean
If progress.IsCancelRequested Then
If MsgBox("Cancel this operation?", vbYesNo) = vbYes Then
ShouldCancel = True
Else
progress.AbortCancellation
End If
End If
End Function
Где ThingsToDo
может быть, например, набором макросов для выполнения.Отчет о проценте выполнения легче с циклом, но хотя он также может работать с последовательностью операций, чистая обработка отмены немного сложнее:
Public Sub Run(ByVal progress As ProgressIndicator)
Dim thingsDone As Long
DoThingOne
If Not UpdateAndContinue(progress, 0.33) Then Exit Sub
DoThingTwo
If Not UpdateAndContinue(progress, 0.66) Then Exit Sub
DoThingThree
If Not UpdateAndContinue(progress, 1) Then Exit Sub
End Sub
Private Function UpdateAndContinue(ByVal progress As ProgressIndicator, ByVal percentCompleted As Double) As Boolean
progress.UpdatePercent percentCompleted
If ShouldCancel(progress) Then
' user confirmed they want to cancel the whole thing.
' perform any clean-up or rollback here
Exit Function
Else
UpdateAndContinue = True
End If
End Function