[TOP] [基本操作] [関数] [お遊び] [マクロを登録][ユーザー定義表示形式][自作メニュー]


＜4、自作メニュー簡単作成＞

2011/8 更新

図のようなプルダウンメニュー



を作るには、
・メニューを右クリックして「ユーザー設定」を選択
・「コマンド」タブから「マクロ」「ユーザー設定メニュー項目」をドラッグ
・「マクロの登録」
という方法が基本ですが、（「マクロを登録」を参考してください）
何かの拍子に、またはエクセルをインストールし直したら、あらまあ、自作メニューがさっぱり消えちゃった！
その大変な手間をまたかけなければならないかと思うと、しばらくはユーザー設定メニューはあきらめたいと思うのだけれど、無いとやっぱり不便でまた作り直し？

作ったメニューを削除したいとき
・メニューを右クリックして「ユーザー設定」を選択
・メニューをワークシート上のドラッグして離す
で、消えます。

マクロのメニューへの登録をマクロでやってしまいましょう。

上の図はmenubarsetting.xlsの一部です。
A列にメニュー項目（ボタン）の名前。グループの始まりには「−」を入れます。
B列に登録するマクロの名前
C列にはボタンのアイコンID
D2にはそのマクロのあるワークブックのフルパスでの名前（見本として適当に入れてありますが、必ず、正しくなおしてください）
D6には新しく作るツールバーやメニューの名前を入れていきます。

「メニュー設定」ボタンのマクロは次の通りです。


ワークブックmenubarsetting.xls（「自作メニュー簡単作成」 下記からダウンロード可）のコードは次のようなものです

Sub メニューを作る() '自作メニューを作ります
Private Const WorksheetMenuBar = "Worksheet Menu Bar"
Private Const ユーザー設定ツールバー = "ユーザー設定ツールバー"
    Const begingroupstring = "-"
    Const MEMU_NAME_C = 1
    Const MACRO_NAME_C = 2
    Const ICON_ID_C = 3
    Const PM_FILE_PATH_C = 4
    
    Dim personalmacropath, commandbar_name, mymenucaption
    Dim menuitems(50, 2), itemsnum, itemname, contorolsnum
    Dim mymenu, actionname, cb, cntrl
    Dim n, begingroup_or, fs, ismenu&
    
    personalmacropath = Cells(2, PM_FILE_PATH_C).Value
    Set fs = CreateObject("Scripting.FileSystemObject")
    If Not (fs.FileExists(personalmacropath)) Then
        MsgBox personalmacropath & "は存在しないようです、調べなおしてください"
        Exit Sub
    End If
    personalmacropath = "'" & personalmacropath & "'!"
    commandbar_name = Cells(4, PM_FILE_PATH_C).Value
    mymenucaption = Cells(6, PM_FILE_PATH_C).Value
    
    For n = 0 To 30
        itemname = Cells(n + 2, MEMU_NAME_C).Formula
        If itemname = "" Then Exit For
        menuitems(n, 0) = itemname
        menuitems(n, 1) = Cells(n + 2, MACRO_NAME_C).Formula
        menuitems(n, 2) = Cells(n + 2, ICON_ID_C).Value
    Next n
    For Each cb In CommandBars
        If cb.Name = commandbar_name Then '当該のツールバーがすでにあれば
            ismenu = 1
            Exit For
        End If
    Next cb
    If ismenu = 1 Then '当該のツールバーがすでにあれば
        For Each cntrl In cb.Controls
                If cntrl.Type = msoControlPopup Then
                    cntrl.Delete '古いポップアップメニューをいったん削除
                End If
                Exit For
' End If
        Next cntrl
    Else 'なければ作る
        Set cb = CommandBars.Add(commandbar_name)
        cb.Enabled = True
        cb.Visible = True
    End If
    
    itemsnum = n
    contorolsnum = 0
    begingroup_or = 0
    '新しいポップアップメニュー
    Set mymenu = CommandBars(commandbar_name).Controls.Add(Type:=msoControlPopup)
    mymenu.Caption = mymenucaption
    
    With mymenu 'コマンドマクロの設定
        For n = 0 To itemsnum - 1
            If menuitems(n, 0) = begingroupstring Then
                begingroup_or = 1
            Else
                contorolsnum = contorolsnum + 1
                .Controls.Add Type:=msoControlButton
                .Controls(contorolsnum).Caption = menuitems(n, 0)
                actionname = personalmacropath & menuitems(n, 1)
                .Controls(contorolsnum).OnAction = actionname
                .Controls(contorolsnum).FaceId = menuitems(n, 2)
                
                If begingroup_or = 1 Then
                    .Controls(contorolsnum).BeginGroup = True
                    begingroup_or = 0
                End If
            End If
        Next n
    End With
    
End Sub


ついでに、ツールバーの名前を全部知るためのマクロ、自分で編集したアイコンをワークシートに保存するためのマクロも付けておきました。
ワークブックファイルのダウンロード

ワークブック menubarsetting.xls (サイズ983KB)

右クリックでダウンロードし、ウィルスチェックしてから役立ててください。