【转】Custom Menu Items Created on the fly With Excel VBA

ref : http://www.ozgrid.com/VBA/custom-menus.htm

 

Sub createMenu()
    Dim cMenu1 As CommandBarControl
    Dim cbMainMenuBar As CommandBar
    'Dim iHelpMenu As Integer
    Dim cbcCutomMenu As CommandBarControl
    '(1)Delete any existing one. We must use On Error Resume next in case it does not exist.
    On Error Resume Next
    Application.CommandBars("Worksheet Menu Bar").Controls("&New Menu").Delete
    On Error GoTo 0
    '(2)Set a CommandBar variable to Worksheet menu bar
    Set cbMainMenuBar = Application.CommandBars("Worksheet Menu Bar")
    '(3)Return the Index number of the Help menu. We can then use this to place a custom menu before.
    'iHelpMenu = cbMainMenuBar.Controls("Help").Index
    '(4)Add a Control to the "Worksheet Menu Bar" before Help.
    'Set a CommandBarControl variable to it
    Set cbcCutomMenu = cbMainMenuBar.Controls.Add(Type:=msoControlPopup) ', Before:=iHelpMenu
    '(5)Give the control a caption
    cbcCutomMenu.Caption = "&New Menu"
    '(6)Working with our new Control, add a sub control and give it a Caption and tell it which macro to run (OnAction).
    With cbcCutomMenu.Controls.Add(Type:=msoControlButton)
        .Caption = "Menu 1"
        .OnAction = "MyMacro1"
    End With
    '(6a)Add another sub control give it a Caption and tell it which macro to run (OnAction)
    With cbcCutomMenu.Controls.Add(Type:=msoControlButton)
        .Caption = "Menu 2"
        .OnAction = "MyMacro2"
    End With
    'Repeat step "6a" for each menu item you want to add.
    'Add another menu that will lead off to another menu
    'Set a CommandBarControl variable to it
    Set cbcCutomMenu = cbcCutomMenu.Controls.Add(Type:=msoControlPopup)
    ' Give the control a caption
    cbcCutomMenu.Caption = "Ne&xt Menu"
    'Add a contol to the sub menu, just created above
    With cbcCutomMenu.Controls.Add(Type:=msoControlButton)
                .Caption = "&Charts"
                .FaceId = 420
                .OnAction = "MyMacro2"
    End With
End Sub

Sub delMenu()
    On Error Resume Next
    Application.CommandBars("Worksheet Menu Bar").Controls("&New Menu").Delete
    On Error GoTo 0
End Sub

Sub MyMacro1()
    MsgBox "123木头人", vbInformation, "测试"
End Sub

Sub MyMacro2()
    MsgBox "321木头人", vbInformation, "测试"

End Sub 

 

This workBook 

Private Sub Workbook_Activate()

    Run "createMenu"

End Sub

Private Sub Workbook_Deactivate()

    Run "delMenu"

End Sub