间接填充自定义功能区上的下拉菜单
Indirectly Populate Drop Down On Custom Ribbon
作为这个问题的后续：
我需要能够根据第一个下拉列表中的选择来填充第二个下拉列表。类似于 "indirect" 数据验证。
我正在努力 "choose" 我 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
您不应在代码中调用功能区回调。相反，当您希望自定义 UI 为 refreshed/invalidated 时，您需要使用 IRibbonUI 的 Invalidate 或 InvalidateControl 方法。
自定义UI 标记上指定的 onLoad 过程返回的对象。该对象包含使控件属性无效和刷新用户界面的方法。
IRibbonUI 对象在与用户交互时不生成事件。相反，功能区元素执行对代码的回调，并且功能区元素和代码之间的链接在描述功能区添加的 XML 中定义。
有关每个 UI 元素可用的回调函数的信息，请在 Customizing the 2007 Office Fluent Ribbon for Developers 中搜索 "How can I determine the correct signatures for each callback procedure?"。
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" …>
在互联网上搜索了 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 等于 unique 回调，分别命名为 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
作为这个问题的后续：
我需要能够根据第一个下拉列表中的选择来填充第二个下拉列表。类似于 "indirect" 数据验证。
我正在努力 "choose" 我 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
您不应在代码中调用功能区回调。相反，当您希望自定义 UI 为 refreshed/invalidated 时，您需要使用 IRibbonUI 的 Invalidate 或 InvalidateControl 方法。
自定义UI 标记上指定的 onLoad 过程返回的对象。该对象包含使控件属性无效和刷新用户界面的方法。
IRibbonUI 对象在与用户交互时不生成事件。相反，功能区元素执行对代码的回调，并且功能区元素和代码之间的链接在描述功能区添加的 XML 中定义。
有关每个 UI 元素可用的回调函数的信息，请在 Customizing the 2007 Office Fluent Ribbon for Developers 中搜索 "How can I determine the correct signatures for each callback procedure?"。
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" …>
在互联网上搜索了 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 等于 unique 回调，分别命名为 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