VBA|自定义菜单栏、工具栏、功能区

Excel2007中，功能区替代了以前的分层菜单、工具栏和任务窗格系统。

自定义菜单栏、工具栏的效果：

主要是使用CommandBars对象模型：

VBA代码：

1 自定义菜单命令组

'自定义菜单命令组
Public Sub creatediyMenu()
    For Each con In Application.CommandBars("Data").Controls
        con.Delete
    Next
    Dim diyMenu As Object
    Dim MenuItem As Variant
    Dim Menusub As Variant
    MenuItem = Array( _
        "首行标题和冻结及边框", "创建工作表目录", _
        "工作表按名称排序", _
        "设置页眉页脚", _
        "隔行插入空行", "删除空行", "删除选定列空单元格的行", _
        "删除超级链接", _
        "删除形状(图形、文本框等)", _
        "设置最后一个字符为上标", _
        "多条件排序(ABCD列)", _
        "多条件筛选(AB列)", _
        "Setting", _
        "选区字符统计", _
        "借书记录", _
        "定位到D列最后一行", _
        "显示或隐藏批注", "删除当前表中批注")
    Menusub = Array( _
        "PERSONAL.XLSB!行操作.首行标题和冻结及边框", _
        "PERSONAL.XLSB!表操作.创建工作表目录", _
        "PERSONAL.XLSB!表操作.sortShtByName", _
        "PERSONAL.XLSB!表操作.设置页眉页脚", _
        "PERSONAL.XLSB!行操作.insertBlankRow", _
        "PERSONAL.XLSB!行操作.DeleteBlankRow", _
        "PERSONAL.XLSB!行操作.批量删除空行_先选定列", _
        "PERSONAL.XLSB!数据编辑.删除超级链接", _
        "PERSONAL.XLSB!数据编辑.删除形状", _
        "PERSONAL.XLSB!数据编辑.设置单元格最后一个字符为上标", _
        "PERSONAL.XLSB!排序与筛选和统计.MoreKeySort", _
        "PERSONAL.XLSB!排序与筛选和统计.Filter_MoreCriteria", _
        "PERSONAL.XLSB!自定义菜单.ExcelSetting", _
        "PERSONAL.XLSB!排序与筛选和统计.textcount", _
        "PERSONAL.XLSB!借书记录.借书记录", "PERSONAL.XLSB!自定义菜单.newRowPos", _
        "PERSONAL.XLSB!排序与筛选和统计.显示或隐藏批注", _
        "PERSONAL.XLSB!排序与筛选和统计.删除当前表中批注")
 
    For i = 0 To UBound(MenuItem)
        Set diyMenu = Application.CommandBars("Data").Controls.Add(Type:=msoControlButton)
        With diyMenu
            .Caption = MenuItem(i)
            .OnAction = Menusub(i)
        End With
    Next i
    Set diyMenu = Nothing
End Sub

2 插入自定义工具栏命令

Sub 插入自定义工具栏命令()
    Dim cmb As Office.CommandBar
    Dim bt As Office.CommandBarButton
    'Call 删除菜单栏
    Set cmb = Application.CommandBars("Formatting")
    Set bt = cmb.Controls.Add(Type:=Office.MsoControlType.msoControlButton)
    With bt
        .Caption = "借书记录"
        .FaceId = 2560
        .Style = msoButtonIconAndCaption
        .OnAction = "PERSONAL.XLSB!借书记录.借书记录"
    End With
End Sub


'下面的Right 过程是自定义按钮的回调函数?
Sub Right()
    Selection.HorizontalAlignment = Excel.Constants.xlRight
End Sub

3 创建新的菜单栏

Const strBarName As String = "我的菜单栏"

Public Sub 创建新的菜单栏()
    Dim cbr As CommandBar, ctl As CommandBarControl
    Call 删除菜单栏
    'For Each con In Application.CommandBars(strBarName).Controls
        'con.Delete
    'Next
    Set cbr = Application.CommandBars.Add(strBarName, MenuBar:=True)
    cbr.Visible = True
    Set ctl = Application.CommandBars("Worksheet Menu Bar").FindControl(ID:=30002)
    ctl.Copy Application.CommandBars(strBarName)   ' 30002文件下拉菜单
    Set ctl = Application.CommandBars("Worksheet Menu Bar").FindControl(ID:=30003)
    'Set ctl = Application.CommandBars("Chart Menu Bar").FindControl(ID:=30003)
    '30003编辑、30004视图、30005插入、30006格式、30007工具
    ctl.Copy Application.CommandBars(strBarName)

    With cbr.Controls.Add(msoControlPopup)
        .Caption = "帮助"
        With .Controls.Add(msoControlButton)
            .Caption = "重置"
            .OnAction = "删除菜单栏"
        End With
        With .Controls.Add(msoControlButton)
            .Caption = "关于"
            .OnAction = "关于"
        End With

    End With
End Sub

Sub 删除菜单栏()
    On Error Resume Next
    Application.CommandBars(strBarName).Delete
    On Error GoTo 0
End Sub

Sub 关于()
    Dim strMsg As String
    strMsg = "这是一个新的菜单栏" & vbCrLf
    strMsg = strMsg & "由" & Application.UserName & "创建"
    MsgBox strMsg, , "关于"
End Sub

自定义功能区参照：

Excel2007｜RibbonX控件 & 自定义功能区

在Excel2013中，创建功能区选项卡的操作非常简单，用户可通过打开“Excel选项"对话框直接进行功能区选项卡和组的创建。

－End－