zoukankan      html  css  js  c++  java
  • 【转】Custom Menu Items Created on the fly With Excel VBA

    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 

  • 相关阅读:
    第五:Nutanix的Prism管理手册
    第四:Nutanix的开关机步骤
    Exchange2016DR(异地容灾)环境:重要
    博客的开始
    sql查询日期型内容+oracle
    expdp导出oracle数据库中指定表空间下数据
    oracle 锁表的解决sql语句(pl/sql 删除表中数据锁表)
    centos 关闭防火墙+开启ssh服务
    显示桌面 我的电脑
    查看电脑连接过的wifi—通过命令行
  • 原文地址:https://www.cnblogs.com/abinxm/p/2277659.html
Copyright © 2011-2022 走看看