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



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

2006/7/10更新

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



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

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

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

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


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

Sub SetMenu() '自作メニューを作ります
    Const Worksheet_Menu_Bar = "Worksheet Menu Bar" '標準ニューバーに作ります
    Const BEGIN_GROUP = "-"
    Const MEMU_NAME_C = 1
    Const MACRO_NAME_C = 2
    Const ICON_ID_C = 3
    Const PM_FILE_PATH_C = 4
    
    Dim personalmacropath, mymenucaption
    Dim menuitems(50, 2), itemsnum, itemname, contorolsnum
    Dim mymenu, actionname, cntrl
    Dim n&, begingroup_or
    
    personalmacropath = "'" & Cells(2, PM_FILE_PATH_C).Value & "'!"
    mymenucaption = Cells(6, PM_FILE_PATH_C).Value
    For n = 0 To 50
        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 cntrl In CommandBars(1).Controls
        If cntrl.Parameter = mymenucaption Then
            cntrl.Delete
        End If
    Next cntrl
    itemsnum = n
    contorolsnum = 0
    begingroup_or = 0
    '新しいメニュー
    Set mymenu = CommandBars(Worksheet_Menu_Bar).Controls.Add(Type:=msoControlPopup)
    mymenu.Caption = mymenucaption
    mymenu.Parameter = mymenucaption
    With mymenu 'コマンドマクロの設定
        For n = 0 To itemsnum - 1
            If menuitems(n, 0) = BEGIN_GROUP 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


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

ワークブック makemenu.xls (サイズ1699KB)
（圧縮ファイル makemenu.lzh サイズ420KB）

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