独自メニュー追加

Excelに独自のメニューを追加するコードです。

ThisWorkbook に記載する事で、ファイルオープン時にメニューを作成し、
ファイルクローズ時にメニューを削除します。

2007以降ではアドイン項目に表示されます。

 Option Explicit  
 Dim i As Long, r As Long  
 'メニュー定義  
 Const Mname1 = "シート振分 (&C)"  
 Const Mname2 = "リスト振分 (&A)"  
 Const Mname3 = "シート保存 (&B)"  
 Private Sub Workbook_Open()  
 '独自メニュー作成  
 Dim NewM As Variant, NewC As Variant  
   r = False  
   For i = 1 To Application.CommandBars.ActiveMenuBar.Controls.Count  
     If Application.CommandBars.ActiveMenuBar.Controls.Item(i).Caption = Mname1 Then r = True  
   Next i  
   If r = False Then  
     Set NewM = Application.CommandBars("Worksheet Menu Bar").Controls.Add(Type:=msoControlPopup, Temporary:=True)  
     NewM.Caption = Mname1  
     NewM.BeginGroup = True  
     NewM.TooltipText = "ヒント表示"  
     'メニューその1  
     Set NewC = NewM.Controls.Add  
     With NewC  
       .Caption = Mname2  
       .OnAction = "実行するマクロ名"  
       .BeginGroup = False  
       .FaceId = 1548  
     End With  
     'メニューその２  
     Set NewC = NewM.Controls.Add  
     With NewC  
       .Caption = Mname3  
       .OnAction = "実行するマクロ名"  
       .BeginGroup = False  
       .FaceId = 271  
     End With  
   End If  
 End Sub  
 Private Sub Workbook_BeforeClose(Cancel As Boolean)  
 '独自メニュー削除  
 With Application.CommandBars.ActiveMenuBar  
   For i = 1 To .Controls.Count  
     If .Controls.Item(i).Caption = Mname1 Then .Controls(Mname1).Delete  
   Next i  
 End With  
 End Sub
ラベル: ,