前往小程序,Get更优阅读体验!
立即前往
首页
学习
活动
专区
工具
TVP
发布
社区首页 >专栏 >VBA专题10-23:使用VBA操控Excel界面之添加动态菜单

VBA专题10-23:使用VBA操控Excel界面之添加动态菜单

作者头像
fanjy
发布2021-03-26 17:11:25
5.9K0
发布2021-03-26 17:11:25
举报
文章被收录于专栏:完美Excel完美Excel

学习Excel技术,关注微信公众号:

excelperfect

在本系列后面的示例程序中,你将会看到如何使用项目和带图像的库控件通过getItemLabel和getItemImage回调属性引用的VBA过程在运行时动态地填充下拉控件。另一个允许动态填充其内容的控件是组合框控件。

动态菜单控件可以在运行时做更多的事,是唯一一个其内容的结构可以在运行时改变的控件,可以包含自定义控件和内置控件——包括其他动态菜单。通过该控件的getContent属性引用的VBA过程,在运行时为菜单内容构建XML代码。

下面介绍一个简单的使用动态菜单控件示例,在工作簿中为三个工作表(名为Data,Analysis,Reports)的每个显示不同的菜单。

1. 创建一个新的工作簿,将其保存为启用宏的工作簿。

2. 分别重命名工作表为Data、Analysis和Reports。

3. 关闭该工作簿,然后在Custom UIEditor中打开。

4. 在Custom UI Editor中,单击Insert并选择Office2007 Custom UI Part。

5. 复制并粘贴下面的XML代码:

group元素不仅能够包含动态菜单,而且还可包含其他控件。

6. 单击工具栏中的Validate按钮检查是否有错误。

7. 保存并关闭该文件。

8. 在Excel中打开该文件。对于弹出的错误消息,单击“确定”。

9. 按Alt+F11激活VBE。

10. 插入标准的VBA模块,复制并粘贴下面的VBA代码:

代码语言:javascript
复制
Public myRibbon As IRibbonUI
 
'Callback for customUI.onLoad
Sub Initialize(ribbon As IRibbonUI)
    Set myRibbon = ribbon
End Sub
 
'Callback for DynamicMenugetContent
Sub GetMenuContent(control As IRibbonControl, ByRef content)
    Dim xml As String
   
    xml = "<menu xmlns=" & _
       """http://schemas.microsoft.com/office/2006/01/customui"">"
       
    Select Case ActiveSheet.Name
        Case "Data"
            xml = xml & "<buttonid=""Btn1"" imageMso=""Cut"""& _
                    " label=""Reformat"""& _
                    "onAction=""Reformat"" />"
            xml = xml & "<checkBoxid=""checkBox1""" & _
                    "label=""Include OEM""" & _
                    "onAction=""Checkbox1_Change""/>"
            xml = xml & "<menuid=""submenu1""label=""Optional"">"
            xml = xml & " <buttonid=""Btn2""" & _
                    "imageMso=""PenComment""" & _
                    "label=""TouchUp""" & _
                    "onAction=""TouchUp""/>"
            xml = xml & " <buttonid=""Btn3""" & _
                    "imageMso=""Breakpoint""" & _
                    "label=""Polish""" & _
                    "onAction=""Polish"" />"
            xml = xml & "<menuSeparator id=""div2"" />"
            xml = xml & " <dynamicMenuid=""subMenu""" & _
                    "label=""Submenu""" & _
                    "getContent=""GetSubContent"" />"
            xml = xml &"</menu>"
            xml = xml & "<buttonidMso=""SortDialog"" />"
           
        Case "Analysis"
            xml = xml & "<buttonid=""Btn1"" imageMso=""_1""" &_
                    "label=""Analysis 1""" & _
                    "onAction=""Analysis1"" />"
            xml = xml & "<buttonid=""Btn2"" imageMso=""_2""" &_
                    " label=""Analysis2""" & _
                    "onAction=""Analysis2"" />"
            xml = xml & "<buttonid=""Btn3"" imageMso=""_3""" &_
                    "label=""Analysis 3""" & _
                    "onAction=""Analysis3"" />"
            xml = xml &"<menuSeparator id=""div2"" />"
            xml = xml &"<dynamicMenu id=""subMenu""" & _
                    "label=""Submenu""" & _
                    "getContent=""GetSubContent"" />"
                   
        Case "Reports"
            xml = xml & "<buttonid=""Btn1"" imageMso=""A""" &_
                    "label=""Report A""" & _
                    "onAction=""ReportA"" />"
            xml = xml & "<buttonid=""Btn2"" imageMso=""B""" &_
                    "label=""Report B""" & _
                    "onAction=""ReportB"" />"
            xml = xml & "<buttonid=""Btn3"" imageMso=""C""" &_
                    "label=""Report C""" & _
                    "onAction=""ReportC"" />"
            xml = xml &"<menuSeparator id=""div2"" />"
            xml = xml &"<dynamicMenu id=""subMenu""" & _
                    "label=""Submenu""" & _
                    "getContent=""GetSubContent"" />"
       
        Case Else
            'Empty dynamic menu
           
    End Select
   
    xml =xml & _
        "</menu>"
                   
    content = xml
   
    'To view the XML code in the Immediatewindow
    'Debug.Print xml
End Sub

当首次打开工作簿或者使动态菜单控件无效时,执行GetMenuContent回调过程。这个过程为动态菜单的内容创建XML代码。

注意,上面的VBA代码以类似于CustomUI Editor中的一种方式缩进,通过使用Debug.Print语句发送构建的XML代码到立即窗口。复制并粘贴该代码到记事本并在每个开标签(例如<menu … >)和每个闭标签(例如<button … />)之后按回车键。

代码语言:javascript
复制
'Callback for Sub Dynamic MenugetContent
Sub GetSubContent(control As IRibbonControl, ByRef SubContent)
    Dim xml As String
   
    xml = "<menu xmlns=" & _
       """http://schemas.microsoft.com/office/2006/01/customui"">"
    xml = xml & "<buttonid=""subBtn1"" label=""P""" &_
            "onAction=""MacroSubBtn1"" />"
    xml = xml & "<buttonid=""subBtn2"" label=""Q""" &_
            " onAction=""MacroSubBtn2""/>"
    xml = xml & "<buttonid=""subBtn3"" label=""R""" &_
            "onAction=""MacroSubBtn3"" />"
    xml = xml & _
            "</menu>"
           
    SubContent = xml
End Sub

为简单起见,所有这三个不同的菜单设置(对于3个不同的工作表)使用相同的子动态菜单。

代码语言:javascript
复制
'Callbacks for the controls inthe dynamic menu
'when the Data sheet isactivated
Sub Reformat(control As IRibbonControl)
    MsgBox "Reformat"
End Sub
 
 
Sub Checkbox1_Change(control As IRibbonControl, pressed As Boolean)
    MsgBox "OEM check box is checked:" & pressed
End Sub
 
Sub TouchUp(control As IRibbonControl)
    MsgBox "TouchUp"
End Sub
 
Sub Polish(control As IRibbonControl)
    MsgBox "Polich"
End Sub
 
 
'Callbacks for the controls inthe dynamic menu
'when the Analysis sheet isactivated
Sub Analysis1(control As IRibbonControl)
    MsgBox "Analysis 1"
End Sub
 
Sub Analysis2(control As IRibbonControl)
    MsgBox "Analysis 2"
End Sub
 
Sub Analysis3(control As IRibbonControl)
    MsgBox "Analysis 3"
End Sub
 
'Callbacks for the controls inthe dynamic menu
'when the Reports sheet isactivated
Sub ReportA(control As IRibbonControl)
    MsgBox "Report A"
End Sub
 
Sub ReportB(control As IRibbonControl)
    MsgBox "Report B"
End Sub
 
Sub ReportC(control As IRibbonControl)
    MsgBox "Report C"
End Sub
 
'Callbacks for the controls inthe sub dynamic menu
Sub MacroSubBtn1(control As IRibbonControl)
    MsgBox "P"
End Sub
 
Sub MacroSubBtn2(control As IRibbonControl)
    MsgBox "Q"
End Sub
 
 
Sub MacroSubBtn3(control As IRibbonControl)
    MsgBox "R"
End Sub
 
 
'Callback for CustomBtn1onAction
Sub MacroCustomButton(control As IRibbonControl)
    MsgBox "Custom Button"
End Sub

11. 在ThisWorkbook模块中插入下面的VBA代码:

代码语言:javascript
复制
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    myRibbon.InvalidateControl "DynamicMenu"
End Sub

12. 保存,关闭,然后重新打开该工作簿。

下面展示了选择不同的工作表时的菜单内容:

保留自定义复选框的勾选条件

在上面的示例XML和VBA代码中,当用户在工作表Data中单击动态菜单中的复选框后,复选框会相应地显示勾选或者取消勾选。

然而,如果用户在设置勾选该复选框后,通过单击工作表标签激活其他工作表,那么动态菜单被无效,与菜单相关的任何数据(包括复选框的勾选条件)将被销毁。当重新激活工作表Data时,通过调用GetMenuContent过程会重新创建菜单,而复选框会重置为其默认值(即,取消勾选条件)。

如果要保留条件,可以在其被无效前存储其状态,然后在重新创建菜单时恢复其状态。这可以通过使用模块级的变量和getPressed回调属性来实现。下面,我们修改现有的VBA代码来实现此目的(加黑的代码是在上面代码中增加的代码):

1. 声明模块级的变量来存储复选框的状态:

代码语言:javascript
复制
Public myRibbon As IRibbonUI
Dim Checkbox1Pressed As Boolean

2. 在GetMenuContent过程中加入为getPressed属性的VBA代码:

代码语言:javascript
复制
Select Case ActiveSheet.Name
        Case "Data"
            xml = xml & "<buttonid=""Btn1"" imageMso=""Cut"""& _
                    "label=""Reformat""" & _
                    "onAction=""Reformat"" />"
            xml = xml & "<checkBoxid=""checkBox1""" & _
                    "label=""Include OEM""" & _
                    "getPressed=""CheckBox1getPressed""" & _
                    "onAction=""Checkbox1_Change""/>"

3. 在Checkbox1_Change过程中包含额外的代码语句,由checkBox元素的onAction属性引用:

代码语言:javascript
复制
Sub Checkbox1_Change(control As IRibbonControl, pressed As Boolean)
    MsgBox "OEM check box is checked:" & pressed
    Checkbox1Pressed = pressed
End Sub

当用户单击该复选框时,执行Checkbox1_Change并在Checkbox1Pressed变量中存储复选框的状态。

4. 插入由getPressed属性引用的CheckBox1getPressed过程:

代码语言:javascript
复制
Sub CheckBox1getPressed(control As IRibbonControl, ByRef returnedVal)
    returnedVal = Checkbox1Pressed
End Sub

当用户重新激活工作表Data并单击动态菜单时,该菜单会重新创建并执行CheckBox1getPressed过程。接着,通过在使复选框无效前存储复选框状态的Checkbox1Pressed变量重新赋值该复选框的状态。

5. 保存,关闭,然后重新打开该工作簿。

现在,复选框能够保留其在动态菜单被无效并重新构建后的状态。正如所看到的,Checkbox1Pressed模块级变量在过程调用之间保留其值。

一般而言,即使工作簿中的代码执行完毕,工作簿中的公共级别变量、模块级变量和过程级静态变量仍然保留其值。可以使用以下四种方法清除这些变量存储的值:

  • 在过程中或者在立即窗口中执行End语句。
  • 在VBE中,选择运行|重新设置。
  • 当VBE显示标准的错误消息框(因为一个未处理的运行时错误发生),可以单击消息框中的结束按钮。
  • 关闭该工作簿文件。

如果没有未处理的错误,你可以只执行前两种方法,而用户可以仅执行最后一种方法。因此,只要该工作簿文件保持打开,Checkbox1Pressed变量就能够合适地反映该复选框的状态。

如果要在用户关闭并重新打开该文件之后保留该复选框的状态,那么可能要在隐藏的工作表或者在Windows注册表中存储其状态。

说明:本专题系列大部分内容学习整理自《Dissectand Learn Excel VBA in 24 Hours:Changingworkbook appearance》,仅供学习研究。

注:如果你有兴趣,你可以到知识星球App的完美Excel社群下载这本书的完整中文版电子书。

欢迎在下面留言,完善本文内容,让更多的人学到更完美的知识。

本文参与?腾讯云自媒体分享计划,分享自微信公众号。
原始发表:2021-03-18,如有侵权请联系?cloudcommunity@tencent.com 删除

本文分享自 完美Excel 微信公众号,前往查看

如有侵权,请联系 cloudcommunity@tencent.com 删除。

本文参与?腾讯云自媒体分享计划? ,欢迎热爱写作的你一起参与!

评论
登录后参与评论
0 条评论
热度
最新
推荐阅读
领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档
http://www.vxiaotou.com