Excel VBA创建自己的工具栏和菜单

 

Option Explicit
'msoBarTop工具栏的Position
'Type为msoControlPopup(As CommandBarPopup)的菜单下可以带子菜单,但是msoControlPopup不支持图标
'Type为msoControlButton(As CommandBarButton)的菜单是msoControlPopup的下级菜单,不带子菜单,支持图标
'以下代码可以实现将自己的菜单添加到Excel菜单栏上及创建自己的工具栏和菜单的功能,更改代码可以实现创建多级菜单,下面的代码只创建了二级菜单
'更改以下代码可以创建你所需要的菜单
'ShortcutText属性表示菜单的快捷键

'添加菜单到指定的现有工具栏上
Function AddMenuToCommandBar(ByVal Index As Integer, ByVal TopMenuName As String)
On Error Resume Next
Application.CommandBars(1).Controls(TopMenuName).Delete '如果存在就删除以前的菜单
On Error GoTo 0

Dim TopMenuItem As CommandBarPopup '顶层菜单
Dim FirstMenuItem As CommandBarPopup '一级子菜单
Dim SecondMenuItem As CommandBarButton '二级子菜单

'顶层菜单CommandBarPopup,不支持图标(只有最后一级菜单才支持图标)
Set TopMenuItem = Application.CommandBars(1).Controls.Add(Type:=msoControlPopup)
    With TopMenuItem
        .Caption = TopMenuName '顶层菜单名
        .TooltipText = "TopMenuItem TooltipText" '菜单提示文字
    End With

'一级子菜单CommandBarPopup,不支持图标(只有最后一级菜单才支持图标)
Set FirstMenuItem = TopMenuItem.Controls.Add(Type:=msoControlPopup)
    With FirstMenuItem
        .Caption = "FirstMenuItem(&F)" '一级菜单名
        .TooltipText = "FirstMenuItem TooltipText" '菜单提示文字
    End With

'二级菜单CommandBarButton,支持图标(只有最后一级菜单才支持图标)
Set SecondMenuItem = FirstMenuItem.Controls.Add(Type:=msoControlButton)
    With SecondMenuItem
        .Caption = "SecondMenuItem(&S)" '二级菜单名
        .TooltipText = "SecondMenuItem TooltipText" '菜单提示文字
        .Style = msoButtonIconAndCaption '菜单样式(图标加文字)
        .FaceId = 263 '图标代号
        .ShortcutText = "Ctrl+Shift+S"
        .OnAction = "Macro" '要执行的子程序
        .BeginGroup = True '添加分割线
    End With
End Function

'创建工具栏,并且添加自己的菜单到新建的工具栏
Function CreateCommandBarAndMenu(ByVal CommandBarName As String, ByVal TopMenuName As String)
On Error Resume Next
Application.CommandBars(CommandBarName).Delete '如果存在就删除以前的菜单
On Error GoTo 0

Dim MyCommandBar As CommandBar '工具栏
Dim TopMenuItem As CommandBarPopup '顶层菜单
Dim FirstMenuItem As CommandBarPopup '一级子菜单
Dim SecondMenuItem As CommandBarButton '二级子菜单

'工具栏
Set MyCommandBar = Application.CommandBars.Add() '创建工具栏(空白)
    With MyCommandBar
        .Visible = True
        .Name = CommandBarName '工具栏的名字
        .Position = msoBarTop 'msoBarMenuBar '工具栏的Position
    End With
   
'顶层菜单CommandBarPopup,不支持图标(只有最后一级菜单才支持图标)
Set TopMenuItem = MyCommandBar.Controls.Add(Type:=msoControlPopup)
    With TopMenuItem
        .Caption = TopMenuName '顶层菜单名
        .TooltipText = "TopMenuItem TooltipText" '菜单提示文字
    End With

'一级子菜单CommandBarPopup,不支持图标(只有最后一级菜单才支持图标)
Set FirstMenuItem = TopMenuItem.Controls.Add(Type:=msoControlPopup)
    With FirstMenuItem
        .Caption = "FirstMenuItem(&F)" '一级菜单名
        .TooltipText = "FirstMenuItem TooltipText" '菜单提示文字
    End With
   
'二级菜单CommandBarButton,支持图标(只有最后一级菜单才支持图标)
Set SecondMenuItem = FirstMenuItem.Controls.Add(Type:=msoControlButton)
    With SecondMenuItem
        .Caption = "SecondMenuItem(&S)" '二级菜单名
        .TooltipText = "SecondMenuItem TooltipText" '菜单提示文字
        .Style = msoButtonIconAndCaption '菜单样式(图标加文字)
        .FaceId = 263 '图标代号
        .ShortcutText = "Ctrl+Shift+S"
        .OnAction = "Macro" '要执行的子程序
        .BeginGroup = True '添加分割线
    End With
End Function

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值