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

fanjy

发布于 2021-03-26 17:14:46

1.5K0

发布于 2021-03-26 17:14:46

文章被收录于专栏：完美Excel完美Excel

学习Excel技术，关注微信公众号：

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 If
End Sub

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

添加其他类型的控件

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

示例XML代码：

在标准VBA模块中的代码：

Public myRibbon As IRibbonUI
Dim Checkbox1Pressed As Boolean
 
'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""" & _
                    "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 xml
End Sub
 
'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
 
'Callbacks for the controls inthe dynamic menu
'when the Data sheet is activated
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
    Checkbox1Pressed = pressed
End Sub
 
Sub CheckBox1getPressed(control As IRibbonControl, ByRef returnedVal)
    returnedVal = Checkbox1Pressed
End 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 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
 
 
'Callback for Btn1 andmenuButton1 onAction
Sub Macro1s(control As IRibbonControl)
    MsgBox control.Tag & "wasclicked."
End Sub
 
'Callback for menuButton2onAction
Sub Macro2s(control As IRibbonControl)
    MsgBox "Macro2s executes."
End Sub
 
'Callback for menuButton3onAction
Sub Macro3s(control As IRibbonControl)
    MsgBox "Macro3s executes."
End Sub
 
'Callback for button1 onAction
Sub Macro1m(control As IRibbonControl)
    MsgBox "Button 1 clicked."
End Sub
 
'Callback for button2 onAction
Sub Macro2m(control As IRibbonControl)
    MsgBox "Button 2 clicked."
End Sub
 
'Callback for button3 onAction
Sub Macro3m(control As IRibbonControl)
    MsgBox "Button 3 clicked."
End Sub
 
'Callback for button4a onAction
Sub Macro4Am(control As IRibbonControl)
    MsgBox "Button 4A clicked."
End Sub
 
'Callback for button4b onAction
Sub Macro4Bm(control As IRibbonControl)
    MsgBox "Button 4B clicked."
End Sub
 
'Callback for button5 onAction
Sub Macro5m(control As IRibbonControl)
    MsgBox "Button 5 clicked."
End Sub
 
'Callback for gallery1 onAction
Sub SelectedColor(control As IRibbonControl, id As String, index As Integer)
    MsgBox "You selected " & id
End 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 If
End Sub

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

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