Могу ли я нажать кнопку в форме MS Access во время выполнения подпрограммы? - PullRequest
0 голосов
/ 17 апреля 2019

У меня есть индикатор выполнения, крошечная всплывающая форма, связанная с выполнением длительной подпрограммы.

Я пытаюсь поместить кнопку отмены в индикатор выполнения. Когда подпрограмма работает в фоновом режиме, я не могу ничего щелкнуть в форме индикатора выполнения.

Есть ли способ нажать кнопку в другой форме, когда подпрограмма выполняется?

1 Ответ

1 голос
/ 17 апреля 2019

Да, это возможно.Используйте 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
...