实战 | Excel伴侣-菜单篇
'**********************************************'*程序名称：Excel伴侣'*作 者：liuxiangtao'*发布版本：Ver7.5'*创建日期：2019-07-15'*更新日期：2019-10-09'**********************************************'--------------------------------------------'在Excel中添加自定义菜单（Excel启动时候添加）'布尔型参数blSetUp控制是否启动时自动添加'-----------------------------------------------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 '子菜单项名称（数组） Const menuSum As Integer = 9 On Error Resume Next '初始化菜单项，重定义数组 ReDim strMenuItem(menuSum + 2, 3) 'VBA数组下界从1开始
strMenuItem(1, 1) = '订单详情(KXB)' strMenuItem(1, 2) = 'showDateForm' strMenuItem(1, 3) = '6997'
strMenuItem(2, 1) = '渠道统计(KXB)' strMenuItem(2, 2) = 'ChannelMatomo' strMenuItem(2, 3) = '1064' strMenuItem(3, 1) = '产品统计(KXB)' strMenuItem(3, 2) = 'ProductMatomo' strMenuItem(3, 3) = '26449' strMenuItem(4, 1) = '转化统计(KXB)' strMenuItem(4, 2) = 'ProductChannle' strMenuItem(4, 3) = '6099' strMenuItem(5, 1) = '频道统计(KXB)' strMenuItem(5, 2) = 'showListPageDateForm' strMenuItem(5, 3) = '6068' strMenuItem(6, 1) = 'KF业绩统计(BK)' strMenuItem(6, 2) = 'bk_KFdata' strMenuItem(6, 3) = '436' strMenuItem(7, 1) = 'BD拓客追踪(BK)' strMenuItem(7, 2) = 'showBKDateForm' strMenuItem(7, 3) = '1065' strMenuItem(8, 1) = '续期数据转换(KF)' strMenuItem(8, 2) = 'showxuQIForm' strMenuItem(8, 3) = '1061' strMenuItem(9, 1) = 'CDN地址转换(IT)' strMenuItem(9, 2) = 'CdnTrans' strMenuItem(9, 3) = '1063' '使用帮助 strMenuItem(menuSum + 1, 1) = '使用帮助(Help)' strMenuItem(menuSum + 1, 2) = 'CallForm_help' strMenuItem(menuSum + 1, 3) = '124' '历史更新 strMenuItem(menuSum + 2, 1) = '版本信息(Ver)' strMenuItem(menuSum + 2, 2) = 'CallVersion' strMenuItem(menuSum + 2, 3) = '723' '禁止屏幕更新，提升运算速度 'Application.ScreenUpdating = False '---添加主菜单 strM = 'Excel伴侣(WJ)' 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 'myMenu.FaceId = '43' End If If blSetUp Then '---添加子菜单，数组第一维的大小 For i = 1 To UBound(strMenuItem) '从数组中获取菜单名称 sMenuItemName = strMenuItem(i, 1) '从数组中获取菜单点击时的方法 sMenuItemFunc = strMenuItem(i, 2) sMenuFaceid = strMenuItem(i, 3) '判断子菜单是否存在 Set mycontrol = myMenu.Controls(sMenuItemName) If Err Then Err.Clear '在菜栏最后位置增加一个按钮 Set mycontrol = myMenu.Controls.Add(Type:=msoControlButton, temporary:=True) With mycontrol .FaceId = sMenuFaceid .Caption = sMenuItemName '菜单项显示名称 .OnAction = sMenuItemFunc '左键单击该菜单项按钮便运行的过程 .Style = msoButtonIconAndCaption '只显示文字和图标 If i = 6 Or i = 8 Or i = 9 Or i = 10 Then .BeginGroup = True End If End With End If Next i Else '清除目标菜单 Application.CommandBars(1).Controls(strM).Delete End IfEnd Function'-------------------------------- 赞 (0)