通过VBA在Excel中添加菜单和菜单项按钮（Excel启动时候添加）

关注

原创最新推荐文章于 2026-05-01 13:40:24 发布 2.4w 阅读 AI 写同款· GEO 优化 ›

VBA之Excel应用第一章第七节:如何向快速访问工具栏添加宏命令按钮 VBA之Excel应用》（版权10178983）是非常经典的，是我推出的第七套教程，定位于初级，目前是第一版修订。这套教程从简单的录制宏开始讲解，一直到窗体的搭建，内容丰富，实例众多。大家可以非常容易的掌握相关的知识，这套教程共三册，十七章，都是我们在利用EXCEL工作过程中需要掌握的知识点，希望大家能掌握利用。今日讲解的内容是:VBA之Excel应用第一章第七节:如何向快速访问工具栏添加宏命令按钮。阅读详情

将以下代码保存到.xlam或.xla(Excel97-2003)文件。

在ThisWorkBook对象中，添加Workbook_Open事件，调用启动菜单过程。
Private Sub Workbook_Open()
    Call MenuSetup(True)
End Sub

'-----------------------------------------------
'在Excel中添加菜单和菜单项按钮（Excel启动时候添加）
'-----------------------------------------------
Public Function MenuSetup(blSetUp As Boolean)
    Dim myMenu As CommandBarPopup
    Dim mycontrol As CommandBarControl
    Dim i As Integer
    Dim sMenuItemName As String     '菜单项的名称
    Dim sMenuItemFunc As String     '菜单项的调用的函数名称
    Dim strM As String              '菜单名称
    Dim strMenuItem() As String     '菜单项名称
 
    On Error Resume Next
    
    '初始化菜单项
    ReDim strMenuItem(3, 2)    'VBA数组下界从1开始
    '菜单项1
    strMenuItem(1, 1) = "菜单项1"
    strMenuItem(1, 2) = "菜单1运行的过程名"
    '菜单项2
    strMenuItem(2, 1) = "菜单项2"
    strMenuItem(2, 2) = "菜单2运行的过程名"
    
    Application.ScreenUpdating = False
    
    '---添加菜单1
    strM = "EBS配套工具"
    Set myMenu = Application.CommandBars(1).Controls(strM)       '判断我的菜单是

否存在？
    If Err Then
        Err.Clear
        Set myMenu = Application.CommandBars(1).Controls.Add

(Type:=msoControlPopup, temporary:=True)
        myMenu.Caption = strM
    End If
    
    If blSetUp Then
            '---添加菜单项目1
            For i = 1 To UBound(strMenuItem)      '数组第一维的大小
                sMenuItemName = strMenuItem(i, 1)
                sMenuItemFunc = strMenuItem(i, 2)
                
                Set mycontrol = myMenu.Controls(sMenuItemName)   '判断子程序是否

存在
                If Err Then
                    Err.Clear
                    Set mycontrol = myMenu.Controls.Add(Type:=msoControlButton, 

temporary:=True) '在菜栏最后位置增加一个按钮
                    With mycontrol
                        .Caption = sMenuItemName                    '菜单项显示名

称
                        .OnAction = sMenuItemFunc                   '左键单击该菜

单项按钮便运行的过程
                        .Style = msoButtonCaption                   '只显示文字
                    End With
                End If
            Next
    Else
        Application.CommandBars(1).Controls(strT).Delete
       
    End If
    
    Application.ScreenUpdating = True
    If Err Then Err.Clear
End Function

Public Sub start_App()
 frmSetFileSheet.Show 0
End Sub

收录于