ツールバー
役立つ？と思って作った実用的なマクロ集で、保存場所は個人用マクロブック（PERSONAL.XLS）です。
ここで使っているマクロ、変数の名前の付け方は
　先頭にマクロは K 、変数は my を付けています。
マクロを実行し出来た ツールバー を画面上部に固定して共通ツールバーとして使います。
このマクロを実行すると下のようになります。
toolbar01
書式を選択するとメニューが現れます。
toolbar02
各プロパティの意味は
  1. OnAction → 実行させるマクロ名
  2. Caption → 表示名
  3. BeginGroup → 仕切り線
  4. FaceId = 59 → フェイスボタン
  5. TooltipText → ポップヒント
ツールバー▲ TOP
Sub K_ToolBar()

''共通ツールバー    2002/6/6
    
    Dim myPPath As String               'PERSONAL.XLS パス
    Dim myPBook As String               'ワークブック名 PERSONAL.XLS
    Dim mypName As String               'PERSONAL.XLS フルパス名
    Dim MyCB As CommandBar
    Dim MyCBC1 As CommandBarPopup
    Dim MyCBC2 As CommandBarButton
    Dim P_BarName As String
    Dim myButton1 As String
    Dim myButton2 As String
    Dim myButton3 As String
    Dim myButton4 As String
    Dim myButton5 As String
    Dim myButtonImage1 As Integer
    Dim myButtonImage2 As Integer
    Dim myButton6 As String
    
''**** はユーザー名が入ります
    myPPath = "C:\Documents and Settings\****\Application Data\Microsoft\Excel\XLSTART\"
    myPBook = "PERSONAL.XLS"
    mypName = myPPath & myPBook

''テスト用 にアクティブワークブックにしてあります。
''テストする時は白紙のワークシートで行ってください。
    mypName = ActiveWorkbook.Name
    
    P_BarName = "K_ToolBar"                 'ツールパーの名前
    myButton1 = "Home"
    myButton2 = "J"
    myButton3 = "補助"
    myButton4 = "書式"
    myButton5 = "その他"
    myButtonImage1 = 87            '"H"
    myButtonImage2 = 89            '"J"
    myButton6 = "Test"

    On Error Resume Next
    CommandBars(P_BarName).Delete
    Set MyCB = Application.CommandBars.Add(Name:=P_BarName)
''----------------------------------------------------------------
    ''1つ目のボタンの作成 (Button)   Before:=1
    Set MyCBC2 = MyCB.Controls.Add(Type:=msoControlButton, Before:=1)
    With MyCBC2
        .FaceId = myButtonImage1
        .Caption = myButton1
        .TooltipText = myButton1
        .OnAction = mypName & "!" & "Macrohome"         '実行させるマクロ名
    End With

''-ドロップダウンで二つのマクロが出る-----------------------------
    ''2つ目のボタンの作成 (Popup)   Before:=2
    Set MyCBC1 = MyCB.Controls.Add(Type:=msoControlPopup, Before:=2)
    With MyCBC1
        .BeginGroup = True                          '仕切り線
        .Caption = myButton2                        '表示名
    End With

    ''ドロップダウンの一つ目  Before:=1  -----------------------------
    Set MyCBC2 = MyCBC1.Controls.Add(Type:=msoControlButton, Before:=1)
    With MyCBC2
        .Caption = "最終セル"
        .OnAction = mypName & "!" & "KLastCell"
         .FaceId = 59                                 'フェイスボタン
   End With

    ''ドロップダウンの二つ目  Before:=2  -----------------------------
    Set MyCBC2 = MyCBC1.Controls.Add(Type:=msoControlButton, Before:=2)
    With MyCBC2
        .Caption = "最下行セル"
        .OnAction = mypName & "!" & "KLastRow"
    End With
''----------------------------------------------------------------
    ''3つ目のボタンの作成 (Popup)   補助
    Set MyCBC1 = MyCB.Controls.Add(Type:=msoControlPopup, Before:=3)
    With MyCBC1
        .BeginGroup = True
        .Caption = myButton3
    End With

    Set MyCBC2 = MyCBC1.Controls.Add(Type:=msoControlButton, Before:=1)
    With MyCBC2
        .Caption = "値 貼付"
        .OnAction = mypName & "!" & "KValuePaste"
    End With

    Set MyCBC2 = MyCBC1.Controls.Add(Type:=msoControlButton, Before:=2)
    With MyCBC2
        .Caption = "値・書式消去"
        .OnAction = mypName & "!" & "KClearSelction"
        .FaceId = 59
    End With

    Set MyCBC2 = MyCBC1.Controls.Add(Type:=msoControlButton, Before:=3)
    With MyCBC2
        .Caption = "文字列連結"
        .OnAction = mypName & "!" & "KStringConnect"
    End With

    Set MyCBC2 = MyCBC1.Controls.Add(Type:=msoControlButton, Before:=4)
    With MyCBC2
        .Caption = "列幅 AutoFit"
        .OnAction = mypName & "!" & "KColAutoFit"
        .FaceId = 59
    End With

    Set MyCBC2 = MyCBC1.Controls.Add(Type:=msoControlButton, Before:=5)
    With MyCBC2
        .Caption = "書式 クリアー"
        .OnAction = mypName & "!" & "KClearFormatSelction"
        .FaceId = 59
    End With

    Set MyCBC2 = MyCBC1.Controls.Add(Type:=msoControlButton, Before:=6)
    With MyCBC2
        .Caption = "リンク除去"
        .OnAction = mypName & "!" & "KLinkRemove"
    End With

    Set MyCBC2 = MyCBC1.Controls.Add(Type:=msoControlButton, Before:=7)
    With MyCBC2
        .Caption = "ClipBoard Clear"
        .OnAction = mypName & "!" & "KClipBoardClear"
    End With

''----------------------------------------------------------------
    ''4つ目のボタンの作成 (Popup)   書式
    Set MyCBC1 = MyCB.Controls.Add(Type:=msoControlPopup, Before:=4)
    With MyCBC1
        .BeginGroup = True
        .Caption = myButton4
    End With

    Set MyCBC2 = MyCBC1.Controls.Add(Type:=msoControlButton, Before:=1)
    With MyCBC2
        .Caption = "m/dd"
        .OnAction = mypName & "!" & "KFormatDatem"
        .FaceId = 59
    End With

    Set MyCBC2 = MyCBC1.Controls.Add(Type:=msoControlButton, Before:=2)
    With MyCBC2
        .Caption = "yy/mm/dd"
        .OnAction = mypName & "!" & "KFormatDateyy"
    End With

    Set MyCBC2 = MyCBC1.Controls.Add(Type:=msoControlButton, Before:=3)
    With MyCBC2
        .Caption = "yyyy/mm/dd"
        .OnAction = mypName & "!" & "KFormatDateyyyy"
    End With

    Set MyCBC2 = MyCBC1.Controls.Add(Type:=msoControlButton, Before:=4)
    With MyCBC2
        .Caption = "罫線 削除"
        .OnAction = mypName & "!" & "K罫線削除01"
    End With

    Set MyCBC2 = MyCBC1.Controls.Add(Type:=msoControlButton, Before:=5)
    With MyCBC2
        .Caption = "書式 行高設定"
        .OnAction = mypName & "!" & "K行高設定"
    End With

    Set MyCBC2 = MyCBC1.Controls.Add(Type:=msoControlButton, Before:=6)
    With MyCBC2
        .Caption = "セル結合 解除"
        .OnAction = mypName & "!" & "Kセル結合解除"
    End With

    Set MyCBC2 = MyCBC1.Controls.Add(Type:=msoControlButton, Before:=7)
    With MyCBC2
        .Caption = "書式 設定"
        .OnAction = mypName & "!" & "K書式設定"
    End With

    Set MyCBC2 = MyCBC1.Controls.Add(Type:=msoControlButton, Before:=8)
    With MyCBC2
        .Caption = "書式 配置折返"
        .OnAction = mypName & "!" & "K配置折返"
    End With

''----------------------------------------------------------------
    ''5つ目のボタンの作成 (Popup)   その他
    Set MyCBC1 = MyCB.Controls.Add(Type:=msoControlPopup, Before:=5)
    With MyCBC1
        .BeginGroup = True
        .Caption = myButton5
    End With

    Set MyCBC2 = MyCBC1.Controls.Add(Type:=msoControlButton, Before:=1)
    With MyCBC2
        .Caption = "Module Export"
        .OnAction = mypName & "!" & "KMoExportCom00"
        .FaceId = 59
    End With

    Set MyCBC2 = MyCBC1.Controls.Add(Type:=msoControlButton, Before:=2)
    With MyCBC2
        .Caption = "Module Import"
        .OnAction = mypName & "!" & "KMoImportCom00"
    End With

    Set MyCBC2 = MyCBC1.Controls.Add(Type:=msoControlButton, Before:=3)
    With MyCBC2
        .Caption = "Module Remove"
        .OnAction = mypName & "!" & "KMoRemove00"
    End With

    Set MyCBC2 = MyCBC1.Controls.Add(Type:=msoControlButton, Before:=4)
    With MyCBC2
        .Caption = "ツールバー 更新"
        .OnAction = mypName & "!" & P_BarName
        .FaceId = 59
    End With

''-ドロップダウンで三つのマクロが出る-----------------------------
    ''6つ目のボタンの作成 (Popup)   Before:=6
    Set MyCBC1 = MyCB.Controls.Add(Type:=msoControlPopup, Before:=6)
    With MyCBC1
        .BeginGroup = True                          '仕切り線
        .Caption = myButton6                        '表示名
    End With
    
    Set MyCBC2 = MyCBC1.Controls.Add(Type:=msoControlButton, Before:=1)
    With MyCBC2
        .Caption = "Test No.1"
        .OnAction = mypName & "!" & "Macrotest01"
        .FaceId = 59                                 'フェイスボタン
    End With

    Set MyCBC2 = MyCBC1.Controls.Add(Type:=msoControlButton, Before:=2)
    With MyCBC2
        .Caption = "Test No.2"
        .OnAction = mypName & "!" & "Macrotest02"
    End With

    Set MyCBC2 = MyCBC1.Controls.Add(Type:=msoControlButton, Before:=3)
    With MyCBC2
        .Caption = "Test No.3"
        .OnAction = mypName & "!" & "Macrotest03"
    End With
'----------------------------------------------------------------
    ''ツールバー表示
    With Application.CommandBars(P_BarName)
        .Visible = True
    End With
End Sub
top