问题
As a follow up to this question:
VBA - Populate Custom Ribbon Drop Down/List Box
I need to be able to populate my second drop down based on the selection from my first drop down. Similar to the "indirect" data validation.
I am struggling to "choose" the drop down in my vba.
Code:
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
I was thinking I could do something like:
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
回答1:
You shouldn't call ribbon callbacks in the code. Instead, you need to use the Invalidate or InvalidateControl methods of the IRibbonUI when you want your custom UI to be refreshed/invalidated.
The object that is returned by the onLoad procedure specified on the customUI tag. The object contains methods for invalidating control properties and for refreshing the user interface.
The IRibbonUI object does not generate events in its interaction with the user. Instead, ribbon elements perform callbacks to your code, and the linkage between ribbon elements and your code is defined in the XML that describes your ribbon additions.
For information about the callback functions available for each UI element, search for "How can I determine the correct signatures for each callback procedure?" in 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
And in the custom XML markup you just need to define the onLoad callback:
<customUI … OnLoad="MyAddInInitialize" …>
回答2:
After DAYS of searching the internet and the help of Eugene and Olle above, I eventually cracked the code!
So, the first thing was that I had to update my XML to have UNIQUE callbacks for EACH DDL. My code therefore looks like this now:
Code:
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="getItemCountDDL1"
getItemLabel="getItemLabelDDL1"
getSelectedItemIndex="getItemIndexDDL1"
onAction="onActionDDL"
/>
<dropDown
id="ddlCurrencyPair"
label="Currency Pair"
getItemCount="getItemCountDDL2"
getItemLabel="getItemLabelDDL2"
getSelectedItemIndex="getItemIndexDDL2"
onAction="onActionDDL"
/>
<dropDown
id="ddlLongShort"
label="Long/Short"
getItemCount="getItemCountDDL3"
getItemLabel="getItemLabelDDL3"
getSelectedItemIndex="getItemIndexDDL3"
onAction="onActionDDL"
/>
</group>
</tab>
</tabs>
</ribbon>
</customUI>
Notice that the getItemCount, getItemLabel, getSelectedItemIndex are equal to unique callbacks, named getItemCountDDL, getItemLabelDDL, getItemIndexDDL respectively, with their unique identifiers being the numbers of each DDL (DDL 1 through 3).
VBA:
Option Explicit
'Global Variables:
Public MyRibbonUI As IRibbonUI
Public strList As String
Public baseCurrency As String
Public ddl_Index As Integer
Public ddl_Label As String
Public baseCurrencies As Variant
Public stringVar As String
'Callback for customUI.onLoad
Sub loadParameters(ribbon As IRibbonUI)
Set MyRibbonUI = ribbon
strList = ""
baseCurrency = "base"
ddl_Index = 0
stringVar = ""
End Sub
'------- Drop Down List 1
Sub getItemCountDDL1(control As IRibbonControl, ByRef count)
strList = "Currency"
count = ThisWorkbook.Names(strList).RefersToRange.Columns.count
End Sub
Sub getItemLabelDDL1(control As IRibbonControl, index As Integer, ByRef label)
Dim rngML As Range
strList = "Currency"
Set rngML = ThisWorkbook.Names(strList).RefersToRange
label = rngML.Cells(index + 1)
ddl_Label = label
End Sub
Sub getItemIndexDDL1(control As IRibbonControl, ByRef index)
If ddl_Index <> 0 Then
index = ddl_Index
Else
index = 0
End If
ddl_Index = index
End Sub
'------- Drop Down List 2
Sub getItemCountDDL2(control As IRibbonControl, ByRef count)
strList = baseCurrency
If baseCurrency <> "--SELECT--" And baseCurrency <> "base" Then
count = ThisWorkbook.Names(strList).RefersToRange.Rows.count
End If
End Sub
Sub getItemLabelDDL2(control As IRibbonControl, index As Integer, ByRef label)
Dim rngML As Range
strList = baseCurrency
If baseCurrency <> "--SELECT--" And baseCurrency <> "base" Then
Set rngML = ThisWorkbook.Names(strList).RefersToRange
label = rngML.Cells(index + 1)
End If
End Sub
Sub getItemIndexDDL2(control As IRibbonControl, ByRef index)
index = 0
End Sub
'------- Drop Down List 3
Sub getItemCountDDL3(control As IRibbonControl, ByRef count)
strList = "ExecutionType"
count = ThisWorkbook.Names(strList).RefersToRange.Rows.count
End Sub
Sub getItemLabelDDL3(control As IRibbonControl, index As Integer, ByRef label)
Dim rngML As Range
strList = "ExecutionType"
Set rngML = ThisWorkbook.Names(strList).RefersToRange
label = rngML.Cells(index + 1)
End Sub
Sub getItemIndexDDL3(control As IRibbonControl, ByRef index)
index = 0
End Sub
'Callback for 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"
strList = "Currency"
ddl_Index = selectedIndex
baseCurrency = ThisWorkbook.Names(strList).RefersToRange.Columns(CLng(selectedIndex + 1)).Value
Call invalidateRibbon
Case "currencyPair"
Case "ddlLongShort"
End Select
End Sub
'-----Invalidate Ribbon
Public Sub invalidateRibbon()
If MyRibbonUI Is Nothing Then Exit Sub
MyRibbonUI.Invalidate
DoEvents
End Sub
来源：https://stackoverflow.com/questions/57215698/indirectly-populate-drop-down-on-custom-ribbon