[Excel][VBA] 処理を一時停止してModelessなユーザーフォームを呼び出し、閉じた後で続きから再開する試み

0.README.md

[Excel][VBA] 処理を一時停止してModelessなユーザーフォームを呼び出し、閉じた後で続きから再開する試み

吉田 拳@sugoi_kaizenさんがツイートで

マクロの実行中にある条件でユーザーフォームをmodelessで出してなんかやった後にそのフォームにつけたボタンクリックしてunloadでフォーム閉じてマクロの続きに戻る…ということはできないんですかね

とおっしゃっていたので、試しにやってみました。

Modeless.UserForm.mp4

Module1.vba

Option Explicit

Sub TestResume()
    Dim TargetSheet As Worksheet: Set TargetSheet = ThisWorkbook.Worksheets("マクロの中断と再開")
    'TargetSheet.Cells.ClearContents
    TargetSheet.Range("A:B").ClearContents
    Dim WorkRow
    For WorkRow = 1 To 20
        Debug.Print "Row", WorkRow
        TargetSheet.Cells(WorkRow, 1).Value = WorkRow
        If WorkRow = 10 Then
            UserForm1.ShowModelessAndWait ' ユーザーフォームを開いて、閉じられるのを待つ
        End If
    Next
End Sub

Sub UnloadForm()
    Unload UserForm1
End Sub

Sub ClearForm()
    Debug.Print "[Before]: UserForm1", ObjPtr(UserForm1)
    Set UserForm1 = Nothing
    Debug.Print "[After] : UserForm1", ObjPtr(UserForm1)
    ' Nothingを設定すると、これ以降標準モジュールで参照できるUserForm1は異なるものとなる
    ' この後でUnload UserForm1としても、別インスタンスになっているため、元のユーザーフォームは閉じられない
    ' → UserForm1.ShowModelessAndWait中でインスタンスの変更を検知して元のフォームをUnloadすることで対処
End Sub

UserForm1.vba

Option Explicit

#If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
#End If

Const UnknownErrorNumber = 7979

Private WaitFlag As Boolean

Private Sub CommandButton1_Click()
    Debug.Print "CommandButton1_Click"
    WaitFlag = False
    Unload Me
End Sub

Private Sub UserForm_Initialize()
    Debug.Print "UserForm_Initialize", "UserForms.Count: " & UserForms.Count
    WaitFlag = False
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Debug.Print "UserForm_QueryClose"
    WaitFlag = False
End Sub

Private Sub UserForm_Terminate()
    Debug.Print "UserForm_Terminate"
    WaitFlag = False
End Sub

Private Function IsDefaultInstance(Optional Target) As Boolean
    If IsMissing(Target) Then Set Target = Me
    IsDefaultInstance = (ObjPtr(Target) = ObjPtr(UserForm1)) ' TODO: 「UserForm1」をモジュール名（オブジェクト名）に合わせて変更する必要あり
End Function

Public Sub ShowModelessAndWait()
    Debug.Print "ShowModelessAndWait: Begin"
    WaitFlag = True
    Show False
'    Do While WaitFlag And IsDefaultInstance() ' デフォルトインスタンスの再割当てが行われた場合（Set UserForm1 = Nothing）に対応
    Do While WaitFlag
        If Not IsDefaultInstance Then
            Debug.Print "デフォルトインスタンス変更を検知!", "WaitFlag: " & WaitFlag
'            Debug.Print "→自身を破棄します"
'            Unload Me ' 不正な操作(Set IsDefaultInstance = Nothing等)有とみなす→自身をUnload
            Err.Raise UnknownErrorNumber, Source:=Me.Name, Description:="Default instance has been changed" ' 不正な動作のため、エラーとする
            Exit Do
        End If
        DoEvents
        Sleep 10
    Loop
    Debug.Print "ShowModelessAndWait: End"
End Sub