Excel功能区下拉项-没有onAction？

Question

我创建了一个自定义标签，其中包含一个项目和按钮的下拉菜单。我可以为按钮运行onAction宏，但不能对项目执行相同的操作。应该可以吗？我已经看到了很多为项目指定onAction宏的示例，但似乎都没有用。我在Visual Studio中还有一个插件witten，它在下拉菜单中似乎是调用宏的项目。

我的代码：

Private Sub Workbook_Activate()

' copied from here:
' https://stackoverflow.com/questions/8850836/how-to-add-a-custom-ribbon-tab-using-vba


Dim hFile As Long
Dim path As String, fileName As String, ribbonXML As String, user As String

hFile = FreeFile
user = Environ("Username")
path = "C:\Users\" & user & "\AppData\Local\Microsoft\Office\"
fileName = "Excel.officeUI"

ribbonXML = "<mso:customUI      xmlns:mso='http://schemas.microsoft.com/office/2009/07/customui'>" & vbNewLine
ribbonXML = ribbonXML + "<mso:ribbon><mso:qat/><mso:tabs><mso:tab id='x' label='Development' insertBeforeQ='mso:TabFormat'>" & vbNewLine 'insertAfterQ='x1:IDC_TEAM_TAB' id='mso_c1.1C4ECC7'
ribbonXML = ribbonXML + "<mso:group id='mso_c2.1C4ECD7' label='Group1' imageMso='Risks' autoScale='true'>" & vbNewLine
ribbonXML = ribbonXML + "<mso:dropDown id='dropDown' label='Test Menu:' onAction='test_macro'>" & vbNewLine
ribbonXML = ribbonXML + "   <mso:item id='item1' label='Item 1' onAction='test_macro'/>" & vbNewLine
ribbonXML = ribbonXML + "   <mso:item id='item2' label='Item 2'  onAction='test_macro'/>" & vbNewLine
ribbonXML = ribbonXML + "   <mso:item id='item3' label='Item 3'  onAction='test_macro'/>" & vbNewLine
ribbonXML = ribbonXML + "   <mso:button id='button' label='Button...' onAction='test_macro'/>" & vbNewLine
ribbonXML = ribbonXML + " </mso:dropDown>" & vbNewLine

ribbonXML = ribbonXML + "</mso:group>" & vbNewLine
ribbonXML = ribbonXML + "<mso:group id='mso_c3.1C56531' label='Group 2' imageMso='ListMacros' autoScale='true'/>" & vbNewLine
ribbonXML = ribbonXML + "</mso:tab></mso:tabs></mso:ribbon></mso:customUI>"

ribbonXML = Replace(ribbonXML, """", "")

Open path & fileName For Output Access Write As hFile
Print #hFile, ribbonXML
Close hFile

End Sub

Private Sub Workbook_Deactivate()

Dim hFile As Long
Dim path As String, fileName As String, ribbonXML As String, user As String

hFile = FreeFile
user = Environ("Username")
path = "C:\Users\" & user & "\AppData\Local\Microsoft\Office\"
fileName = "Excel.officeUI"

ribbonXML = "<mso:customUI           xmlns:mso=""http://schemas.microsoft.com/office/2009/07/customui"">" & _
"<mso:ribbon></mso:ribbon></mso:customUI>"

Open path & fileName For Output Access Write As hFile
Print #hFile, ribbonXML
Close hFile

End Sub

和：

Sub test_macro()
    Sheets("Sheet1").Select
    Cells(1, 1) = "test"
End Sub

Answer 1

下拉菜单中有一个“正在执行的操作”。您将获得该项目的索引。在我的示例中，您可以在Excel UI功能区的下拉菜单中选择3种语言。第一项“英语”为0，第二项“Français”为1，而我的第三项“ Nederlands”为2。蓝色代表我在xml中的适应性：

在VBA中，就像按钮一样，我更改了我的命名常量值（或执行任何您想要的操作）。

Sub DDonAction(control As IRibbonControl, id As String, index As Variant) Select Case control.id 'Case dropdown if multiple dropdowns Case "DDLanguage" Select Case index Case 0 'Action if English is selected ActiveWorkbook.Names("Language").RefersToR1C1 = "=""Eng""" Case 1 'Action if 'Français' is selected ActiveWorkbook.Names("Language").RefersToR1C1 = "=""Fr""" Case 2 'Action if Nederlands is selected ActiveWorkbook.Names("Language").RefersToR1C1 = "=""Nl""" End Select 'item End Select 'Dropdown End Sub