作为这个问题的后续行动:
VBA - Populate Custom Ribbon Drop Down/List Box
我需要能够根据我的第一个下拉列表中的选择来填充我的第二个下拉列表。类似于“间接”数据验证。
我正在努力“选择”我的 vba 中的下拉菜单。
代码:
XML:
<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" onLoad="LoadParameters">
<ribbon startFromScratch="false">
<tabs>
<tab id="myCustomTab" label="Currencies">
<group id="displayCurrencies" label="Selected Currencies">
<dropDown
id="ddlBaseCurrency"
label="Base Currency"
getItemCount="getItemCountDDL"
getItemLabel="getItemLabelDDL"
getSelectedItemIndex="getItemIndexDDL"
onAction="onActionDDL"
/>
<dropDown
id="ddlCurrencyPair"
label="Currency Pair"
getItemCount="getItemCountDDL"
getItemLabel="getItemLabelDDL"
getSelectedItemIndex="getItemIndexDDL"
onAction="onActionDDL"
/>
<dropDown
id="ddlLongShort"
label="Long/Short"
getItemCount="getItemCountDDL"
getItemLabel="getItemLabelDDL"
getSelectedItemIndex="getItemIndexDDL"
onAction="onActionDDL"
/>
</group>
</tab>
</tabs>
</ribbon>
</customUI>
VB
Option Explicit
'Global Variables:
Public MyRibbonUI As IRibbonUI
Public count As Integer
Public strList As String
Public stringVar As String
Public baseCurrency As String
Public ddl_Index As Integer
Public ddl_Label As String
Public baseCurrencies As Variant
'Callback for customUI.onLoad
Sub loadParameters(ribbon As IRibbonUI)
Set MyRibbonUI = ribbon
strList = ""
count = 0
stringVar = ""
baseCurrency = "base"
baseCurrencies = Array("USD", "EUR", "GBP", "AUD", "NZD", "CAD", "CHF", "METALS", "OIL")
End Sub
'Callback for ddlBaseCurrency getItemCount
Sub getItemCountDDL(control As IRibbonControl, ByRef count)
'On Error Resume Next
Dim currencyPairs As Variant
Dim index As Integer
Dim i As Long
Select Case control.id
Case "ddlBaseCurrency"
For i = 0 To UBound(baseCurrencies)
If baseCurrency <> "--SELECT--" And baseCurrency <> "base" And InStr(baseCurrency, "/") = 0 Then
strList = baseCurrency
count = ThisWorkbook.Names(strList).RefersToRange.Rows.count
Exit For
ElseIf baseCurrency = "base" Or baseCurrency = "--SELECT--" Then
strList = "Currency"
count = ThisWorkbook.Names(strList).RefersToRange.Columns.count
Exit For
End If
Next
Case "ddlLongShort"
strList = "ExecutionType"
count = ThisWorkbook.Names(strList).RefersToRange.Rows.count
End Select
End Sub
'Callback for ddlBaseCurrency getItemLabel
Sub getItemLabelDDL(control As IRibbonControl, index As Integer, ByRef label)
Dim rngML As Range
Dim i As Long
Select Case control.id
Case "ddlBaseCurrency"
For i = 0 To UBound(baseCurrencies)
If baseCurrency <> "--SELECT--" And baseCurrency <> "base" And InStr(baseCurrency, "/") = 0 Then
strList = baseCurrency
Exit For
ElseIf baseCurrency = "base" Or baseCurrency = "--SELECT--" Then
strList = "Currency"
Exit For
End If
Next
Case "ddlLongShort"
strList = "ExecutionType"
End Select
Set rngML = ThisWorkbook.Names(strList).RefersToRange
label = rngML.Cells(index + 1)
ddl_Label = label
End Sub
'Callback for ddlBaseCurrency getSelectedItemIndex
Sub getItemIndexDDL(control As IRibbonControl, ByRef index)
'Ensure first item in dropdown is displayed.
Select Case control.id
Case Is = "ddlBaseCurrency"
index = 0
Case Is = "ddlLongShort"
index = 0
End Select
ddl_Index = index
End Sub
'Callback for ddlBaseCurrency onAction
Sub onActionDDL(control As IRibbonControl, id As String, selectedIndex As Integer)
Dim i As Long
Dim arrayCount As Long
arrayCount = 0
Select Case control.id
Case "ddlBaseCurrency"
For i = 0 To UBound(baseCurrencies)
If baseCurrencies(i) = baseCurrency Then
arrayCount = 1
ElseIf baseCurrency = "base" Or baseCurrency = "--SELECT--" Then
arrayCount = 2
End If
Next
Select Case arrayCount
Case 1
Call getItemCountDDL(control, count)
Call getItemIndexDDL(control, ddl_Index)
Call getItemLabelDDL(control, ddl_Index, ddl_Label)
Call GetListOfCurrencies
' strList = baseCurrency
' baseCurrency = ThisWorkbook.Names(strList).RefersToRange.Rows(CLng(selectedIndex + 1)).Value
Case 2
strList = "Currency"
baseCurrency = ThisWorkbook.Names(strList).RefersToRange.Columns(CLng(selectedIndex + 1)).Value
End Select
Case "ddlLongShort"
strList = "ExecutionType"
End Select
End Sub
Public Sub GetListOfCurrencies()
If MyRibbonUI Is Nothing Then Exit Sub
MyRibbonUI.InvalidateControl ("ddlBaseCurrency")
DoEvents
End Sub
我在想我可以做类似的事情:
For each control on tab("custom tab")
bCurrency = Findcontrol.control.id("ddlBaseCurrency").Value
cPair = Findcontrol.control.id("ddlCurrencyPair")
For i = 0 To UBound(currencyPairs)
If bCurrency = currencyPairs(i) Then
'Do the indirect validation in here
End If
Next
Next
最佳答案
您不应在代码中调用功能区回调。相反，您需要使用 Invalidate或 InvalidateControl IRibbonUI 的方法当您希望您的自定义 UI 被刷新/失效时。
在 customUI 标记上指定的 onLoad 过程返回的对象。该对象包含使控件属性无效和刷新用户界面的方法。IRibbonUI对象在与用户的交互中不生成事件。相反，功能区元素对代码执行回调，功能区元素和代码之间的链接在描述功能区添加的 XML 中定义。
有关每个 UI 元素可用的回调函数的信息，请搜索“如何确定每个回调过程的正确签名？”在 Customizing the 2007 Office Fluent Ribbon for Developers .
Dim MyRibbon As IRibbonUI
Sub MyAddInInitialize(Ribbon As IRibbonUI)
Set MyRibbon = Ribbon
End Sub
Sub myFunction()
MyRibbon.Invalidate() ' Invalidates the caches of all of this add-in's controls
End Sub
在自定义 XML 标记中，您只需定义
onLoad打回来:<customUI … OnLoad="MyAddInInitialize" …>
关于excel - 间接填充自定义功能区上的下拉菜单，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/57215698/