'ツールバーボタン名称変更マクロ

'新規ブックにモジュールシートを挿入し、以下のマクロをコピー貼り付けします。
'MakeDialogSheet()を実行してダイアログシートを作成します。
'ダイアログシートは適当に変更してください。
'ToolbarButtonRename()を実行するとダイアログボックスが表示されます。

Option Explicit

Const DialogSheetName = "DialogTbbRename"

Sub MakeDialogSheet()
    Dim dlg As DialogSheet
    Dim gw As Double
    On Error Resume Next
    Set dlg = Sheets(DialogSheetName)
    On Error GoTo 0
    If Not (dlg Is Nothing) Then
        MsgBox (DialogSheetName & " はすでに存在します。")
        Exit Sub
    End If
    Set dlg = DialogSheets.Add
    With dlg
        .Name = DialogSheetName
        gw = .Buttons(1).Height / 3
        .DialogFrame.Left = gw * 10
        .DialogFrame.Top = gw * 4
        .DialogFrame.Width = gw * 68
        .DialogFrame.Height = gw * 27
        .DialogFrame.Caption = "ツールバーボタンの名称変更"
        .DialogFrame.OnAction = "Form1_Load"
        .DrawingObjects.Delete
    End With
    With dlg.Labels.Add(Left:=gw * 11, Top:=gw * 8, _
        Width:=gw * 27, Height:=gw * 3)
        .Caption = "ツールバー"
    End With
    With dlg.Labels.Add(Left:=gw * 39, Top:=gw * 8, _
        Width:=gw * 27, Height:=gw * 3)
        .Caption = "ツールバーボタン"
    End With
    With dlg.ListBoxes.Add(Left:=gw * 11, Top:=gw * 11, _
        Width:=gw * 27, Height:=gw * 19)
        .OnAction = "List1_Change"
        .MultiSelect = xlNone
    End With
    With dlg.ListBoxes.Add(Left:=gw * 39, Top:=gw * 11, _
        Width:=gw * 27, Height:=gw * 19)
        .MultiSelect = xlNone
    End With
    With dlg.Buttons.Add(Left:=gw * 67, Top:=gw * 8, _
        Width:=gw * 10, Height:=gw * 3)
        .Caption = "閉じる"
        .DismissButton = True
        .CancelButton = False
        .DefaultButton = False
    End With
    With dlg.Buttons.Add(Left:=gw * 67, Top:=gw * 12, _
        Width:=gw * 10, Height:=gw * 3)
        .OnAction = "Button2_Click"
        .Caption = "名称変更"
        .DismissButton = False
        .CancelButton = False
        .DefaultButton = False
    End With
End Sub

' ダイアログを表示するマクロ
Sub ToolbarButtonRename()
    ThisWorkbook.DialogSheets(DialogSheetName).Show
End Sub

'ダイアログフレームに登録するマクロ
Sub Form1_Load()
    Dim obj As Object
    With ActiveDialog.ListBoxes(1)
        '1つめのリストボックスにツールバー名を設定
        .RemoveAllItems
        For Each obj In Toolbars
            .AddItem obj.Name
        Next
        If .ListCount > 0 Then .ListIndex = 1
    End With
    '2つめのリストボックスにボタン名を設定
    List1_Change
End Sub

'ツールバー一覧のリストボックスに登録するマクロ
'（ツールバーボタン一覧を設定する）
Sub List1_Change()
    Dim lst1 As Object, lst2 As Object, obj As Object
    Set lst1 = ActiveDialog.ListBoxes(1)
    Set lst2 = ActiveDialog.ListBoxes(2)
    lst2.RemoveAllItems
    If lst1.ListCount < 1 Then Exit Sub
    For Each obj In Toolbars(lst1.List(lst1.ListIndex)).ToolbarButtons
        If obj.IsGap Then
            'ボタン間隔の場合、"-"を表示する
            lst2.AddItem "-"
        ElseIf obj.BuiltIn Then
            '組み込みボタンの場合、"*"を先頭に表示する
            lst2.AddItem "* " & obj.Name
        Else
            lst2.AddItem obj.Name
        End If
    Next
    If lst2.ListCount > 0 Then lst2.ListIndex = 1
End Sub

'名称変更するマクロ
Sub Button2_Click()
    Dim lst1 As Object, lst2 As Object, obj As Object
    Dim ret As Variant

    Set lst1 = ActiveDialog.ListBoxes(1)
    Set lst2 = ActiveDialog.ListBoxes(2)

    If lst1.ListCount < 1 Or lst2.ListCount < 1 Then Exit Sub
    Set obj = Toolbars(lst1.List(lst1.ListIndex)) _
        .ToolbarButtons(lst2.ListIndex)

    If obj.IsGap Then
        Exit Sub
    ElseIf obj.BuiltIn Then
        MsgBox "組み込みボタンの名前は変更できません。", vbExclamation, _
            "ツールバーボタンの名称変更"
        Exit Sub
    End If

    SendKeys "{F2}"
    ret = Application.InputBox( _
        prompt:="新しいツールバーボタンの名前を入力してください。", _
        Title:="ツールバーボタンの名称変更", default:=obj.Name, _
        Type:=2)
    If VarType(ret) = vbBoolean Then Exit Sub
    obj.Name = ret
    lst2.List(lst2.ListIndex) = ret
End Sub