繁体   English   中英

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

[英]excel ribbon dropdown items - no onAction?

我创建了一个自定义标签,其中包含项目和按钮的下拉菜单。 我可以为按钮运行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

下拉菜单有一个“ onaction”。 您将获得该项目的索引。 在我的示例中,您可以在Excel UI功能区的下拉菜单中选择3种语言。 第一项“英语”为0,第二项“Français”为1,而我的第三项“ Nederlands”为2。 在此处输入图片说明

在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

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM