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