xml - excel功能区下拉项目 - 没有onAction？

Question

我创建了一个带有下拉菜单的自定义选项卡，其中包含项目和按钮。我可以让 onAction 宏为按钮运行，但不能为项目做同样的事情。这应该可能吗？我已经看到很多为项目指定 onAction 宏的示例，但似乎没有一个有效。我在 Visual Studio 中也有一个加载项，它在下拉列表中似乎有调用宏的项目。

我的代码：

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

标签： xmlexcelribbonvba

Answer 1

下拉菜单中有一个“onaction”。您将获得该项目的索引。在我的示例中，您可以在 Excel UI 功能区的下拉列表中选择 3 种语言。第一项“English”是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