【VB开源代码栏目提醒】:文章导读:在新的一年中,各位网友都进入紧张的学习或是工作阶段。
网学会员整理了VB开源代码-怎样在EXCEL中创建自定义菜单 vb源代码 - 培训资料的相关内容供大家参考,祝大家在新的一年里工作和学习顺利!
EXCEL
vb Sub addToolBar Dim foundflag As Boolean 增加工具栏 foundflag False For Each ct In CommandBarsstandard.Controls Debug.Print ct.Caption If ct.Caption myMenu:我的自定义菜单 Then Else foundflag True End If Next If foundflag False Then Set newitem CommandBarsstandard.Controls.AddType:msoControlButton ID:1 Before:19 --------------------------工具栏名称--------------类型 ----按钮--------ID为1自定义------位置-------- With newitem .Style msoButtonIconAndCaption 同时显示图标和说明 .Style msoButtonIcon 仅显示按键图标 .Caption myMenu:我的自定义菜单 为按键写文字说明 .OnAction showAbout 指定工作的宏 .FaceId 459 End With End If End Sub Sub addMenu Dim foundflag As Boolean 增加菜单栏 foundflag False For Each ct In CommandBarsWorksheet Menu Bar.Controls Debug.Print ct.Caption If ct.Caption 我的自定义菜单A Then Else foundflag True End If Next If foundflag False Then Set newMenu CommandBarsWorksheet Menu Bar.Controls.AddType:msoControlPopup ID:1 Before:8 --------------------------工具栏名称--------------类型 ----按钮--------ID为1自定义------位置-------- With newMenu .Caption 我的自定义菜单A 为按键写文字说明 .Controls.Add Type:msoControlPopup ID:1 再加入一层表单 加这个按键就不判断了,直接加,今后有扩展再另做方法 Set AboutMenu .Controls.AddType:msoControlButton ID:1 下拉菜单也是按钮 With AboutMenu .Caption 关于我的菜单A .Style msoControlIconAndCaption .OnAction showAbout .FaceId 459 .BeginGroup True 画上一线条 End With Set nuinstallMenu .Controls.AddType:msoControlButton ID:1 With nuinstallMenu 复原 .Caption 卸载自定义菜单U .Style msoControlIconAndCaption .OnAction uninstall .FaceId 330 End With End With End If End Sub Sub AddrightMenu 增加右键菜单 Dim foundflag As Boolean foundflag False For Each ct In CommandBarscell.Controls Debug.Print ct.Caption If ct.Caption 我的自定义菜单A Then Else foundflag True End If Next If foundflag False Then Set newMenu CommandBarscell.Controls.AddType:msoControlPopup ID:1 --------------------------工具栏名称--------------类型 ----按钮--------ID为1自定义------位置-------- With newMenu .Caption 我的自定义菜单A 为按键写文字说明 .FaceId 577 因为这是个多重菜单,所以没有图标,如果要图标,就只能一层,用按键 .BeginGroup True 画上一线条 Set nextMenu .Controls.AddType:msoControlButton ID:1 With nextMenu .Caption 关于我的菜单A .Style msoControlIconAndCaption .OnAction showAbout .FaceId 459 End With End With End If Application.CommandBarsPivotTable Context Menu.Reset End Sub Sub showAbout f_About.Show vbModal End Sub Sub rightMenuReset 右键菜单复位 Application.CommandBarscell.Reset End Sub Sub uninstall 卸载 If MsgBox你确认要卸载我的自定义菜单吗? vbOKCancel vbQuestion YiDie提醒您: vbOK Then Application.CommandBarscell.Reset Application.CommandBarsWorksheet Menu Bar.Reset Application.CommandBarsstandard.Reset MsgBox 菜单已复原! vbOKOnly vbInformation YiDie提醒您: Else MsgBox 卸载操作已取消 vbOKOnly vbInformation YiDie提醒您: End If End Sub