VBA专题10-24：使用VBA操控Excel界面之单元格上下文菜单（Excel 2010及以后的版...

excelperfect

添加按钮控件

假设你需要对工作表中前面有货币符号的值执行计算，然而那些值被解释为文本，你要编写VBA过程来移除所选单元格区域中的货币符号。要使该过程更易访问，你想在单元格上下文菜单中放置其快捷方式。下面的XML代码和VBA代码完成上述任务。

示例XML代码：

注意，在Custom UI Editor中，要选择Insert|Office 2010 Custom UI Part，因为2007中没有contextMenus作为其子元素。

在标准的VBA模块中的过程：

Sub RemoveUSD(control As IRibbonControl) Dim workRng As Range Dim Item As Range On Error Resume Next Set workRng = Intersect(Selection, _ Selection.Cells.SpecialCells(xlCellTypeConstants, xlTextValues)) If Not workRng Is Nothing Then For Each Item In workRng If UCase(Left(Item, 3)) ='USD' Then Item = Right(Item, Len(Item) -3) End If Next Item End IfEnd Sub

下图展示了在单元格上下文菜单中的Remove USD按钮：

添加其他类型的控件

除了上面介绍的使用XML代码在单元格上下文菜单中添加按钮控件外，还可以添加6种其他类型的内置控件和自定义控件：切换按钮、拆分按钮、菜单、库、复选框和动态菜单。

示例XML代码：

在标准VBA模块中的代码：

Public myRibbon As IRibbonUIDim Checkbox1Pressed As Boolean 'Callback for customUI.onLoadSub Initialize(ribbon As IRibbonUI)    Set myRibbon = ribbonEnd Sub 'Callback for DynamicMenugetContentSub 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''' & _                    'getPressed=''CheckBox1getPressed''' & _                    '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 & '<dynamicMenu id=''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=''Analysis 2''' & _                    '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 xmlEnd Sub 'Callback for Sub Dynamic MenugetContentSub 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 = xmlEnd Sub 'Callbacks for the controls inthe dynamic menu'when the Data sheet is activatedSub Reformat(control As IRibbonControl)    MsgBox 'Reformat'End Sub  Sub Checkbox1_Change(control As IRibbonControl, pressed As Boolean)    MsgBox 'OEM check box is checked:' & pressed    Checkbox1Pressed = pressedEnd Sub Sub CheckBox1getPressed(control As IRibbonControl, ByRef returnedVal)    returnedVal = Checkbox1PressedEnd Sub Sub TouchUp(control AsIRibbonControl)    MsgBox 'TouchUp'End Sub Sub Polish(control As IRibbonControl)    MsgBox 'Polich'End Sub  'Callbacks for the controls inthe dynamic menu'when the Analysis sheet isactivatedSub 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 isactivatedSub 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 menuSub 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 CustomBtn1onActionSub MacroCustomButton(control As IRibbonControl)    MsgBox 'Custom Button'End Sub  'Callback for Btn1 andmenuButton1 onActionSub Macro1s(control As IRibbonControl)    MsgBox control.Tag & 'wasclicked.'End Sub 'Callback for menuButton2onActionSub Macro2s(control As IRibbonControl)    MsgBox 'Macro2s executes.'End Sub 'Callback for menuButton3onActionSub Macro3s(control As IRibbonControl)    MsgBox 'Macro3s executes.'End Sub 'Callback for button1 onActionSub Macro1m(control As IRibbonControl)    MsgBox 'Button 1 clicked.'End Sub 'Callback for button2 onActionSub Macro2m(control As IRibbonControl)    MsgBox 'Button 2 clicked.'End Sub 'Callback for button3 onActionSub Macro3m(control As IRibbonControl)    MsgBox 'Button 3 clicked.'End Sub 'Callback for button4a onActionSub Macro4Am(control As IRibbonControl)    MsgBox 'Button 4A clicked.'End Sub 'Callback for button4b onActionSub Macro4Bm(control As IRibbonControl)    MsgBox 'Button 4B clicked.'End Sub 'Callback for button5 onActionSub Macro5m(control As IRibbonControl)    MsgBox 'Button 5 clicked.'End Sub 'Callback for gallery1 onActionSub SelectedColor(control As IRibbonControl, id As String, index As Integer)    MsgBox 'You selected ' & idEnd Sub Sub RemoveUSD(control As IRibbonControl)    Dim workRng As Range    Dim Item As Range       On Error Resume Next    Set workRng = Intersect(Selection, _       Selection.Cells.SpecialCells(xlCellTypeConstants, xlTextValues))    If Not workRng Is Nothing Then        For Each Item In workRng            If UCase(Left(Item, 3)) ='USD' Then                Item = Right(Item, Len(Item) -3)            End If        Next Item    End IfEnd Sub

在功能区《VBA专题10-23：使用VBA操控Excel界面之添加动态菜单》一文中，当用户激活不同的工作表时，在Workbook_SheetActivate事件处理中明确地使菜单无效（为了重新构建菜单）。然而，如果动态菜单在单元格上下文菜单中，那么不需要编写VBA代码来使菜单无效。当用户右击工作表单元格时，动态菜单在单元格上下文菜单显示其内容的过程中重新创建。

下图展示了含有不同类型的（自定义和内置的）控件的单元格上下文菜单：

注意，无法将控件添加到Excel 2007中的单元格上下文菜单和更早的XML代码中。然而，使用VBA代码实现添加控件仍然是可能的。

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

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

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

欢迎到知识星球：完美Excel社群，进行技术交流和提问，获取更多电子资料。