问题描述
我无法填充下拉列表框.
I cannot get the drop down/list box to populate.
原始代码来自:
https://exceloffthegrid.com/inserting-a-动态下拉功能区/
下面的VBA代码在一个模块中,而XML代码在第二个模块中.功能区是在工作簿打开时创建的.
Below code for VBA is in one module and the XML code in a second module. The ribbon is created as the workbook opens.
我的代码:
VBA:
VBA:
Option Explicit
'testRibbon is a variable which contains the Ribbon
Public testRibbon As IRibbonUI
Sub testRibbon_onLoad(ByVal ribbon As Office.IRibbonUI)
Set testRibbon = ribbon
End Sub
Public Sub DropDown_getItemCount(control As IRibbonControl, ByRef returnedVal)
Dim Workbook As Workbook
Dim Worksheet As Worksheet
Dim myCell As Range
Dim LastColumn As Long
Set logBook = Workbooks("Journal.xlsm")
Set dataSheet = logBook.Worksheets("Data Sheet")
Set myCell = dataSheet.Range("B3")
ColumnNumber = myCell.End(xlToRight).Column
'Convert To Column Letter
ColumnLetter = Split(Cells(1, ColumnNumber).Address, "$")(1)
Set myCell = dataSheet.Range("B3:" & ColumnLetter & "3")
returnedVal = 0
For x = 1 To myCell.Columns.Count
card1 = myCell.Cells(1, x).Value
If card1 <> "" And Len(card1 & vbNullString) > 0 Then
returnedVal = returnedVal + 1
End If
Next x
End Sub
Public Sub DropDown_getItemID(control As IRibbonControl, index As Integer, ByRef id)
id = "Base Currency: " & index
End Sub
Public Sub DropDown_getItemLabel(control As IRibbonControl, index As Integer, ByRef returnedVal)
Dim Workbook As Workbook
Dim Worksheet As Worksheet
Dim myCell As Range
Set logBook = Workbooks("Journal.xlsm")
Set dataSheet = logBook.Worksheets("Data Sheet")
Set myCell = dataSheet.Range("B3")
returnedVal = myCell.Value
End Sub
Public Sub DropDown_getSelectedItemID(control As IRibbonControl, ByRef id)
id = "--SELECT--"
End Sub
Sub updateRibbon()
testRibbon.Invalidate
End Sub
XML:
XML:
Sub LoadCustRibbon()
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>" & vbNewLine
ribbonXML = ribbonXML + " <mso:qat/>" & vbNewLine
ribbonXML = ribbonXML + " <mso:tabs>" & vbNewLine
'Group 1
ribbonXML = ribbonXML + " <mso:tab id='myTab' label='Tab1' insertBeforeQ='mso:TabFormat'>" & vbNewLine
ribbonXML = ribbonXML + " <mso:group id='sendSubmit' label='Submit' autoScale='true'>" & vbNewLine
'Drop Down
ribbonXML = ribbonXML + " <mso:dropDown id='DropDown' label='myList' " & vbNewLine
ribbonXML = ribbonXML + " onAction='DropDown_onAction' " & vbNewLine
ribbonXML = ribbonXML + " getSelectedItemID='DropDown_getSelectedItemID' " & vbNewLine
ribbonXML = ribbonXML + " getItemLabel='DropDown_getItemLabel' " & vbNewLine
ribbonXML = ribbonXML + " getItemID='DropDown_getItemID' " & vbNewLine
ribbonXML = ribbonXML + " getItemCount='DropDown_getItemCount'" & vbNewLine
ribbonXML = ribbonXML + " />" & vbNewLine
ribbonXML = ribbonXML + " </mso:group>" & vbNewLine
ribbonXML = ribbonXML + " </mso:tab>" & vbNewLine
ribbonXML = ribbonXML + " </mso:tabs>" & vbNewLine
ribbonXML = ribbonXML + " </mso:ribbon>" & vbNewLine
ribbonXML = ribbonXML + " </mso:customUI>"
ribbonXML = Replace(ribbonXML, """", "")
Open path & fileName For Output Access Write As hFile
Print #hFile, ribbonXML
Close hFile
End Sub
我已完全按照本教程中的说明复制了代码,但我只是无法填写下拉框-即使我按照工作簿中的工作表的建议进行操作也是如此.
I have copied the code exactly as in the tutorial but I just cannot get the drop box to populate - even when I do it as they suggest with the sheets in the workbook.
希望有人可以提供帮助,这使我发疯. :/
Hope someone can help, this is driving me crazy. :/
推荐答案
设法找到一个教程,该教程解释了我正在尝试实现的目标的正确用法.
Managed to find a tutorial that explains the correct usage of what I was trying to achieve.
链接:
https://www.contextures.com/excelribbonmacrostab.html
链接中信息的突出显示:
Highlights of the information in the link:
- 下载用于Microsoft Office的自定义UI编辑器
- 使用自定义UI编辑器"打开您要添加自定义设置的excel文件
- 加载到编辑器中后,右键单击该文件,然后选择所需的Office兼容性以使其他更改生效(2010选项适用于Office 2010-当前)
- 将在编辑器内创建XML文件"并将其链接到原始excel文件
- 将XML代码插入编辑器
- 通过单击编辑器任务栏中的验证按钮进行代码检查
- 点击生成回调按钮,该按钮将创建VBA中所需的子,以传递参数或标识XML上的元素(在自定义"标签中)-复制回调记事本
- 提供的一切看起来不错,并且验证不会引发任何错误,保存更改并打开excel文件-现在应该在其中包含自定义内容
- 使用自定义功能将回叫粘贴到VBA中的excel文件模块中
- Download Custom UI Editor for Microsoft Office
- Open the excel file you want to add the customizations to - using the Custom UI Editor
- Right click on the file once loaded in the editor and choose your preferred office compatibility for the additional changes to work in (The 2010 option works for office 2010 - current)
- An XML "file" will be created and linked to your original excel file WITHIN the editor
- Insert your XML code into the editor
- Do a code check by clicking on the Validate button in the task bar of the editor
- Click the Generate Callbacks button which will create the sub's needed in VBA to pass parameters or identify elements on the XML (in the custom tab) - Copy the call backs to notepad
- Provided everything looks good and the validation does not throw any errors, save the changes and open your excel file - which should now have the customizations in it
- Paste the call backs in a module in VBA for the excel file with customizations
2010年及以后的XML代码示例:
Example of XML Code for 2010 and Up:
代码:
Code:
<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui">
<ribbon startFromScratch="false">
<tabs>
<tab id="myLogTab" label="Logbook">
<group id="setup" label="Setup">
<button
id="btnSubmit"
label="Submit"
imageMso="GoTo"
size="large"
onAction="Submit"
/>
<dropDown
id="ddlBase"
label="Base"
getItemCount="DropDown_getItemCount"
getItemLabel="DropDown_getItemLabel"
getSelectedItemIndex="GetSelItemIndex"
onAction="DropDown_onAction"
/>
<editBox
id="txtEntry"
label="Entry"
getText="MyEditBoxCallbackgetText"
onChange="MyEditBoxCallbackOnChange"
/>
</group>
<group id="logSummary" label="Summary">
<labelControl
id="lblTotal"
label="Total"
/>
</group>
</tab>
</tabs>
</ribbon>
</customUI>
VBA示例:
代码:
Code:
Option Explicit
'https://www.contextures.com/excelribbondynamictab.html
Public myRibbon As IRibbonUI
Sub Onload(ribbon As IRibbonUI)
'Create a ribbon instance for use in this project
Set myRibbon = ribbon
End Sub
'Callback for ddlBase getItemCount
Sub DropDown_getItemCount(control As IRibbonControl, ByRef count)
End Sub
'Callback for ddlBase getItemLabel
Sub DropDown_getItemLabel(control As IRibbonControl, Index As Integer, ByRef label)
End Sub
'Callback for ddlBase getSelectedItemIndex
Sub GetSelItemIndex(control As IRibbonControl, ByRef Index)
End Sub
'Callback for ddlBase onAction
Sub DropDown_onAction(control As IRibbonControl, id As String, Index As Integer)
End Sub
'Callback for txtEntry getText
Sub MyEditBoxCallbackgetText(control As IRibbonControl, ByRef returnedVal)
End Sub
'Callback for txtEntry onChange
Sub MyEditBoxCallbackOnChange(control As IRibbonControl, text As String)
End Sub
这篇关于VBA-填充自定义功能区下拉列表框的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!