[VBA]疑似モーダル画面

#疑似モーダルダイアログ.md

疑似モーダルダイアログ (VBA)

If MsgBox("OK か Cancel を押すまで、呼び出し元の画面を操作できません。", vbOkCancel) = vbCancel Then
    Exit Sub
End If

上記の記述だと、メッセージボックスを閉じるまで呼び出し元の画面を操作できません。

そこで、呼び出し元を操作可能なメッセージボックスを自作してみます。

ここでは UserForm をメッセージボックス代わりに使います。
しかしそのまま Show メソッドで呼び出すと、下記のような問題が生じます。

• モーダル( vbModal )指定だと、呼び出し元を操作できないままになってしまう
• モードレス( vbModeless )指定にすると、呼び出し元で待ち合わせることなく、すぐに次の行が実行されてしまう。

これを解決する実装を組んでみました。呼び出す側はこのように書きます。

If Module1.ShowUserForm1Modally("閉じるまで待ち合わせつつ、呼び出し元の操作も可能") = vbCancel Then
    Exit Sub
End If

実装の仕組み

モードレス画面を「疑似モーダル画面」として実装するにあたって、重要なのは 2 点です。

1. 呼び出す側：モードレスな子画面が閉じられるまで、次のステートメントに進んでしまわないよう待ち合わせるための仕組み。
2. 呼ばれる側：自画面が閉じられたとき、あるいは OK/Cancel ボタンが押されたときなどに、そのことを呼び出し側に伝えるための仕組み。

呼び出す側 の処理

モードレス画面が閉じられるまで、呼び出し側はループ処理を使って待ち続けます。 無限ループするだけでは画面操作ができなくなるので、適宜 DoEvents 関数を呼び出す必要があります。

このとき、無条件に DoEvents を呼び続けることもできますが、不必要なタイミングでも呼び出されてしまうため、MsgWaitForMultipleObjects API を併用して無駄な CPU 消費を抑えるようにします。

これによって実行中のスレッドが Windows Message (画面の再描画やマウス・キーボード操作など)を受信した時にだけ DoEvents が呼び出されるようにすることができます。

呼ばれる側 (子画面側) の処理

今回は「OK/Cancel が押されたかどうか」「画面が閉じられたかどうか」を表すための変数を UserForm 上に設けています。

変数の値が変化したことを呼び出し元のモジュールに伝えるためには、「イベント通知を使う」「コールバックメソッドを呼び出す」といった手法がありますが、今回は UserForm のモジュール上にて自分が自分自身を呼び出す形にすることで通知の手間を省いています。

Module1.bas

'=== 標準モジュール
Option Explicit

'疑似モーダル画面の呼び出し
Public Function ShowUserForm1Modally(ByVal msg As String) As VbMsgBoxResult
    With New UserForm1  'インスタンスを明確にするため、必ず New して呼び出します
        ShowUserForm1Modally = .UserForm1_ShowDialog(msg)  '自作の Friend メソッドを呼び出しています
    End With
End Function

UserForm1.frm

'=== UserForm1
'Button を 2 つ (OK/Cancel) と Label を 1 つ貼っておいてください

Option Explicit

Private Declare PtrSafe Function MsgWaitForMultipleObjects Lib "user32" ( _
    ByVal nCount As Long, _
    ByRef pHandles As LongPtr, _
    ByVal fWaitAll As Long, _
    ByVal dwMilliseconds As Long, _
    ByVal dwWakeMask As Long) As Long
Private m_DialogResult As VbMsgBoxResult
Private m_Closed As Boolean

Private Sub UserForm_Initialize()
    Set UserForm1 = Nothing     'New なしで UserForm1.Show を呼ぶことを禁止します
    m_DialogResult = vbCancel   '右上[×]で閉じられた場合は Cancel 扱いとする
    m_Closed = False            'この画面が閉じられたら True に変更
End Sub
Private Sub UserForm_Terminate()
    m_Closed = True
End Sub

Private Sub CommandButton1_Click()
    m_DialogResult = vbOK
    Unload Me
End Sub
Private Sub CommandButton2_Click()
    m_DialogResult = vbCancel
    Unload Me
End Sub

'UserForm1 をモードレスで表示するけれど、閉じられるまで戻り値を返さないメソッド
Friend Function UserForm1_ShowDialog(ByVal msg As String) As VbMsgBoxResult
    Const INFINITE As Long = &HFFFFFFFF
    Const QS_ALLINPUT As Long = &HFF&
    m_DialogResult = vbCancel  '右上[×]で閉じられた場合は Cancel 扱い
    m_Closed = False
            
    '必要に応じて、パラメーターを受け渡します
    '(VBA には引数付きコンストラクタが無いので、New 後に受け渡すしかない)
    Me.Label1.Caption = msg

    '自分で自分をモードレス表示する
    Me.Show vbModeless

    '自画面が閉じられるまで、ループで待ち合わせる
    Do Until m_Closed
        If MsgWaitForMultipleObjects(0, 0, 0, INFINITE, QS_ALLINPUT) = 0 Then
            DoEvents   'メッセージを受信したら処理する
        End If
    Loop

    '自画面が閉じられたので、ローカル変数に保持しておいた値を戻り値で返す
    UserForm1_ShowDialog = m_DialogResult
End Function

ご紹介いただいた疑似モーダルダイアログをエクセルのVBAに組み込みました。
このダイアログの表示中に、エクセルのワークシートの操作ができます。
また、新たなブックを開くこともできます。
ところが、新たに開いたブックを閉じると、疑似モーダルダイアログも消えてなくなってしまって、どうしようもなくなります。
新たに開いたブックを閉じても、疑似モーダルダイアログが消えない様にすることはできますか？