Indirectly Populate Drop Down On Custom Ribbon

问题:

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