Attribute VB_Name = "Module1"
'■　マクロ５００連発＜第２段＞
'
'　コマンドバーコントロールのID一覧表を作成する
'
'  Copyright(C) 2000 Sunago
'
'　　第１弾で作成したマクロ４３２の機能強化版です。
'　このマクロはEXCEL(Application)のコマンドバーだけでなく、
'　VBEditorのコマンドバー一覧を作成するマクロ(Macro2)を
'  追加しました。VBEditorのコマンドバーを利用するには、
'　Application.VBE.Commandbars のように記述します。
'
Option Explicit

'■　EXCELのコマンドバー一覧を作成する
Sub Macro1()
Dim mySheet As Worksheet
Dim myCBar As Office.CommandBar
Dim myCBarName As String
Dim myCtrl0 As Office.CommandBarControl
Dim myCtrl1 As Office.CommandBarControl
Dim myCtrl2 As Office.CommandBarControl


    '処理を早くするおまじない(画面の更新を止める)
    Application.ScreenUpdating = False

    'バージョンごとに出力先シートを切り替える
    Select Case Left$(Application.Version, 1)
        Case "8"
            Worksheets("xl97App").Select
        Case "9"
            Worksheets("xl2000App").Select
        Case Else
            Worksheets(2).Select
            Sheets(2).Name = "xl" & Application.Version & "App"
    End Select
    
    Cells.Clear                         '出力シートを初期化する
    Range("A1").Select                  '基準行をA1とする
    ActiveCell.Value = "Index"
    ActiveCell.Offset(, 1) = "Name"
    ActiveCell.Offset(, 2) = "Id"
    ActiveCell.Offset(, 3) = "Caption"
    ActiveCell.Offset(, 4) = "Id"
    ActiveCell.Offset(, 5) = "Caption"
    ActiveCell.Offset(, 6) = "Id"
    ActiveCell.Offset(, 7) = "Caption"
    
    ActiveCell.Offset(1).Select         '基準行を+1する
    'コマンドバーを取得するループ
    For Each myCBar In Application.CommandBars
        ActiveCell.Value = myCBar.Index
        ActiveCell.Offset(, 1) = myCBar.Name
        myCBarName = myCBar.Name
        '１階層目のコントロールを取得するループ
        For Each myCtrl0 In myCBar.Controls
            ActiveCell.Offset(, 2) = myCtrl0.Id
            ActiveCell.Offset(, 3) = myCtrl0.Caption
            On Error Resume Next
            '２階層目のコントロールを取得するループ
            For Each myCtrl1 In myCtrl0.Controls
                ActiveCell.Offset(, 4) = myCtrl1.Id
                ActiveCell.Offset(, 5) = myCtrl1.Caption
                '３階層目のコントロールを取得するループ
                For Each myCtrl2 In myCtrl1.Controls
                    ActiveCell.Offset(, 6) = myCtrl2.Id
                    ActiveCell.Offset(, 7) = myCtrl2.Caption
                    ActiveCell.Offset(1).Select     '基準行を+1する
                Next
            Next
            On Error GoTo 0
        Next
    Next
    '列幅を自動調整する
    Columns("A:H").AutoFit
    'ズーム(75%)を設定する
    ActiveWindow.Zoom = 75
    
    Application.ScreenUpdating = True
    
End Sub

'■　VBEditorのコマンドバー一覧を作成する
Sub Macro2()
Dim mySheet As Worksheet
Dim myCBar As Office.CommandBar
Dim myCBarName As String
Dim myCtrl0 As Office.CommandBarControl
Dim myCtrl1 As Office.CommandBarControl
Dim myCtrl2 As Office.CommandBarControl


    '処理を早くするおまじない(画面の更新を止める)
    Application.ScreenUpdating = False

    'バージョンごとに出力先シートを切り替える
    Select Case Left$(Application.Version, 1)
        Case "8"
            Worksheets("xl97Vbe").Select
        Case "9"
            Worksheets("xl2000Vbe").Select
        Case Else
            Worksheets(3).Select
            Sheets(3).Name = "xl" & Application.Version & "App"
    End Select
    
    Cells.Clear                         '出力シートを初期化する
    Range("A1").Select                  '基準行をA1とする
    ActiveCell.Value = "Index"
    ActiveCell.Offset(, 1) = "Name"
    ActiveCell.Offset(, 2) = "Id"
    ActiveCell.Offset(, 3) = "Caption"
    ActiveCell.Offset(, 4) = "Id"
    ActiveCell.Offset(, 5) = "Caption"
    ActiveCell.Offset(, 6) = "Id"
    ActiveCell.Offset(, 7) = "Caption"
    
    ActiveCell.Offset(1).Select         '基準行を+1する
    'コマンドバーを取得するループ
    For Each myCBar In Application.VBE.CommandBars
        ActiveCell.Value = myCBar.Index
        ActiveCell.Offset(, 1) = myCBar.Name
        myCBarName = myCBar.Name
        '１階層目のコントロールを取得するループ
        For Each myCtrl0 In myCBar.Controls
            ActiveCell.Offset(, 2) = myCtrl0.Id
            ActiveCell.Offset(, 3) = myCtrl0.Caption
            On Error Resume Next
            '２階層目のコントロールを取得するループ
            For Each myCtrl1 In myCtrl0.Controls
                ActiveCell.Offset(, 4) = myCtrl1.Id
                ActiveCell.Offset(, 5) = myCtrl1.Caption
                '３階層目のコントロールを取得するループ
                For Each myCtrl2 In myCtrl1.Controls
                    ActiveCell.Offset(, 6) = myCtrl2.Id
                    ActiveCell.Offset(, 7) = myCtrl2.Caption
                    ActiveCell.Offset(1).Select     '基準行を+1する
                Next
            Next
            On Error GoTo 0
        Next
    Next
    '列幅を自動調整する
    Columns("A:H").AutoFit
    'ズーム(75%)を設定する
    ActiveWindow.Zoom = 75
    
    Application.ScreenUpdating = True

End Sub