间接填充自定义功能区上的下拉菜单答案

【问题标题】：Indirectly Populate Drop Down On Custom Ribbon间接填充自定义功能区上的下拉菜单
【发布时间】：2019-08-01 00:59:19
【问题描述】：

作为对这个问题的跟进：

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>

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

【问题讨论】：

您是否尝试过此答案中的示例：stackoverflow.com/a/43583223/1490783 如果您可以使示例正常工作，则可以将其与上述逻辑相结合并获得所需的结果。此外，您可能需要提供您的自定义 UI XML 以获得更具体的帮助。
@OlleSjögren 感谢您的回复并查看！ :) 我确实看过你的帖子，但如果不调用实际的“回调”方法，我就无法填充第二个 DDL。目前，上述 VBA 在一定程度上可以工作，但逻辑在某处不正确，因为它使两个下拉菜单都无效 - 即使在第二个下拉菜单中选择了一个值。
@OlleSjögren 你是个天才！！由于您的示例，我设法解决了它：D 答案发布在下面。 :)

标签： excel vba ribbonx

【解决方案1】：

您不应在代码中调用功能区回调。相反，当您希望自定义 UI 被刷新/失效时，您需要使用 IRibbonUI 的 Invalidate 或 InvalidateControl 方法。

在 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" …>

【讨论】：

感谢您的回复。 :) 我已将代码更改为没有回调，但我似乎仍然无法根据第一个下拉列表中的值填充第二个下拉列表。我需要在两个下拉菜单之间进行验证。
你需要使用回调。我建议发布您现在拥有的代码。
再次感谢您的回复。我在周末对代码进行了一些处理，您会注意到我最终将调用放在了 onAction 回调中的 3 个回调。我似乎无法根据在主要下拉列表中选择的内容来填充第二个下拉列表。所以我正在做的是获取第一个值并存储它，然后使控件无效并用我需要的列表重新填充它。如果您有更好的方法，请分享。这让我发疯：/ - 或者，如果您可以协助填充第二个 DDL... :)
再次感谢您。我不太了解它的工作方式，但后来我在@olle 帖子上读到，当功能区无效时，会再次自动调用 selectedItemIndex。然后我知道为什么你说我使用它的方式在代码中没有回调。所以谢谢！ :)

【解决方案2】：

在网上搜索了 DAYS 天，在上面 Eugene 和 Olle 的帮助下，我终于破解了密码！

所以，第一件事是我必须更新我的 XML，以便为 EACH DDL 提供 UNIQUE 回调。因此，我的代码现在看起来像这样：

代码：

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 ）。

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

【讨论】：