'*************************************************'
'* 可任意扩展的菜单及功能代码 *'
'* ------------------------------- *'
'* 日期：2009-10-1 *'
'*************************************************'
Sub AddCustomMenu() '建立自定义菜单主调程序
On Error Resume Next
Application.ScreenUpdating = False
For i = Application.MenuBars(xlWorksheet).Menus.Count To 1 Step -1
Application.MenuBars(xlWorksheet).Menus.Item(i).Delete
Next i
With Application
.CommandBars("Standard").Visible = False
.CommandBars("Formatting").Visible = False
.CommandBars("Stop Recording").Visible = False
.CommandBars("toolbar list").Enabled = False
.CommandBars.DisableAskAQuestionDropdown = True
.DisplayFormulaBar = False
End With
Dim cmb As CommandBarControl
Set cmb = AddCustomCommandBarPopup("主菜单1(&字母)") '设置主菜单
AddCustomCommandBarItem cmb, "下级菜单1(&字母)", "宏1", False, True, 0, "" '设置下级菜单并调用宏1
Set cmb = Application.CommandBars("Worksheet Menu Bar").Controls("主菜单1(&字母)")
AddCustomCommandBarItem cmb, "下级菜单1(&字母)", "", False, True, 0, "" '与"下级菜单1(&字母)"菜单同级
Set cmb = AddCustomCommandBarPopup("主菜单2(&字母)") '设置主菜单
AddCustomCommandBarItem cmb, "下级菜单2", "宏2", False, True, 0, "" '设置下级菜单并调用宏2
'可任意扩展菜单项
'……
End Sub
Function AddCustomCommandBarPopup(Caption As String) As CommandBarControl '添加主菜单项
Dim cmb As CommandBarControl
Set cmb = Application.CommandBars("Worksheet Menu Bar").Controls.Add(msoControlPopup)
cmb.Caption = Caption
cmb.Visible = True
Set AddCustomCommandBarPopup = cmb
End Function
Sub AddCustomCommandBarItem(cmbc As CommandBarControl, _
Caption As String, Macro As String, NewGroup As Boolean, Enable As Boolean, FId As Integer, ShortT As String) '添加菜单选项
Dim cbb As CommandBarButton
Set cbb = cmbc.Controls.Add(msoControlButton)
cbb.Caption = Caption
If FId > 0 Then cbb.FaceId = FId
If ShortT <> "" Then cbb.ShortcutText = ShortT
cbb.OnAction = Macro
cbb.BeginGroup = NewGroup
cbb.Enabled = Enable
End Sub
Function AddCustomCommandBarPopup2(cmbc As CommandBarControl, Caption As String) As CommandBarControl '添加子菜单项
Dim cmb As CommandBarControl
Set cmb = cmbc.Controls.Add(msoControlPopup)
cmb.Caption = Caption
cmb.Visible = True
Set AddCustomCommandBarPopup2 = cmb
End Function
|
