выпадающие элементы ленты Excel - нет onAction?

Question

Я создал пользовательскую вкладку с раскрывающимся списком, в котором есть как элементы, так и кнопки. Я могу заставить макрос onAction работать для кнопки, но не могу сделать то же самое для элемента. Это должно быть возможно? Я видел множество примеров с макросами onAction, указанными для элементов, но ни один из них не работает. У меня также есть надстройка в визуальной студии, в которой есть элементы в выпадающем меню, которые вызывают макросы.

Мой код:

Private Sub Workbook_Activate()

' copied from here:
' /6306266/kak-dobavit-polzovatelskuy-vkladku-lenty-s-pomoschy-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. Первый элемент "Английский" равен 0, второй элемент "Французский" равен 1, а мой третий элемент "Нидерланды" равен 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