'組み込みダイアログ一覧を作成するマクロ

'AllDlg1.xlsとAllDlg2.xlsに以下のマクロを作成します。
'2つのファイルは同じフォルダに置きます。
'AllDlg2.xlsだけを開き、MakeAllDialogsList()を実行してください。
'所用時間は約10分です。

'AllDlg1.xls のマクロ

Option Explicit

Dim dialogNo As Integer

'ダイアログを表示するマクロ
Sub AllDialogsShow()
    On Error GoTo err_1
    dialogNo = dialogNo + 1
    ActiveCell.Cells(1, 3).Value = dialogNo
    Application.Dialogs(dialogNo).Show
    Exit Sub
err_1:
    MsgBox "", , "Error"
End Sub

'現在のダイアログ番号を返す関数
Function GetDialogNo() As Integer
    GetDialogNo = dialogNo
End Function

'ダイアログ番号の初期値を設定するマクロ
Sub SetDialogNo(no As Integer)
    dialogNo = no
End Sub


'AllDlg2.xls のマクロ

Option Explicit

Declare Function GetForegroundWindow Lib "user32" () As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, _
    ByVal lpString As String, ByVal cch As Long) As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _
    ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Const StartNo = 1
Const EndNo = 500
Const WaitTime = 15

Sub MakeAllDialogsList()
    Dim rowNo As Integer
    Dim xlApp As Object
    Dim sht1 As Object
    Dim hwnd As Long, n As Long
    Dim s As String
    Dim t As Date

    If MsgBox("起動する2つ目のExcelが終了するまで一切操作はしないでください。" _
        & Chr$(10) & "中断に失敗するとExcelがハングアップすることがあります。" _
        & Chr$(10) & "所用時間は約10分です。途中で止まっても" & _
        WaitTime & "秒後に自動的に再開されます。", _
        vbOKCancel Or vbExclamation, "MakeAllDialogsList") _
        <> vbOK Then Exit Sub
    Set sht1 = Worksheets.Add
    sht1.Cells.Clear
    rowNo = 0

    'もうひとつExcelを起動する
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True

    'マクロブックを開く
    xlApp.Workbooks.Open ThisWorkbook.Path & "\AllDlg1.xls"

    'Ctrl+lでマクロが起動するようにする
    xlApp.MacroOptions Macro:="AllDialogsShow", _
        HasShortcutKey:=True, ShortcutKey:="l"

    'ダイアログ番号の初期値を設定する
    xlApp.Run "SetDialogNo", StartNo - 1

    '作業用ワークシートを追加する
    xlApp.Worksheets.Add
    xlApp.ActiveSheet.Cells(1, 1).Select
    xlApp.Selection.Value = "Dialog_No"

    Do While True

        'ダイアログ表示マクロを起動
        SendKeys "^l"

        t = Now + TimeSerial(0, 0, WaitTime)
        Do
            DoEvents

            'タイムアウト
            If Now > t Then
                hwnd = 0
                Exit Do
            Else
                'アクティブウィンドウがXLMAINでなくなったら抜ける
                hwnd = GetForegroundWindow()
                s = String(255, " ")
                n = GetClassName(hwnd, s, Len(s))
            End If
        Loop While LeftB$(s, n) = "XLMAIN"

        If hwnd = 0 Then
            'タイムアウトの場合の処理
            rowNo = rowNo + 1
            sht1.Cells(rowNo, 2).Value = "Microsoft Excel"
        Else
            'ウィンドウテキストの取得
            s = String(255, " ")
            n = GetWindowText(hwnd, s, Len(s))
            rowNo = rowNo + 1
            sht1.Cells(rowNo, 2).Value = LeftB$(s, n)
        End If

        'ダイアログを閉じる（念のため2回）
        SendKeys "{ESC}{ESC}"

        '現在のダイアログ番号を取得する
        sht1.Cells(rowNo, 1).Value = xlApp.Run("GetDialogNo")

        '上限になったら終了する
        If sht1.Cells(rowNo, 1).Value >= EndNo Then
            xlApp.ActiveWorkbook.Close False
            xlApp.Quit
            Set xlApp = Nothing
            Exit Do
        End If
    Loop
End Sub