间接填充自定义功能区上的下拉菜单 [英] Indirectly Populate Drop Down On Custom Ribbon

问题描述

作为对该问题的后续行动:

As a follow up to this question:

VBA-填充自定义功能区下拉列表/列表框

我需要能够根据从第一个下拉菜单中选择的内容来填充第二个下拉菜单.类似于间接"数据验证.

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.

我正在努力选择"我的vba中的下拉列表.

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

推荐答案

经过几天的互联网搜索以及上述 Eugene 和 Olle 的帮助，我终于破解了代码！

After DAYS of searching the internet and the help of Eugene and Olle above, I eventually cracked the code!

所以，第一件事是我必须更新XML以具有每个DDL 的 UNIQUE 回调.因此，我的代码现在看起来像这样:

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>

请注意，getItemCount, getItemLabel, getSelectedItemIndex分别等于唯一回调，分别命名为getItemCountDDL, getItemLabelDDL, getItemIndexDDL，其唯一标识符是每个DDL的编号( DDL 1到3 ).

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

这篇关于间接填充自定义功能区上的下拉菜单的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！