微光角落 林海:细品RibbonX(24)：dropDown控件详解

与组合框控件相似，dropDown控件提供用户一组预定义列表以供用户从中选择。此外，能够在设计时使用XML提供的静态列表，或者在运行时通过回调动态填充列表。

组合框和下拉控件最大的不同在于组合框可以接受用户输入，而下拉控件则不行，用户只能从预定义的列表并且仅能从该列表中选择项目。

下面是一些使用下拉控件的理由：

n         不希望用户输入它们自已的信息。

n         列表不长，因此不涉及到使用“自动完成”功能。

n         没兴趣编程回调来验证用户输入数据。

1、dropDown元素必需的属性

dropDown控件需要下表1所列的id属性之一。

表1：dorpDown元素必需的属性

属性

何时使用

id

当创建自已的下拉列表时

idMso

当使用现有的Microsoft下拉列表时

idQ

当在命名空间之间创建共享的下拉列表时

2、带有回调签名的可选的静态属性和动态属性

dropDown元素可以使用下表2列出的任一insert属性。

表2：dropDown元素可选的insert属性

INSERT属性

允许值

默认值

何时使用

insertAfterMso

有效的Mso组

在组末尾插入

在Microsoft控件之后插入

insertBeforeMso

有效的Mso组

在组末尾插入

在Microsoft控件之前插入

insertAfterQ

有效的组idQ

在组末尾插入

在共享的命名空间控件之后插入

insertBeforeQ

有效的组idQ

在组末尾插入

在共享的命名空间控件之前插入

也可以为下拉列表设置下表3所列的任何或所有的属性或回调。

表3：dropDown元素可选的属性和回调

静态属性

动态属性

允许值

默认值

动态属性的VBA回调签名

enabled

getEnabled

true,false,1,0

true

Sub GetEnabled(control

 As IRibbonControl,

ByRef returnedVal)

image

getImage

1至1024个字符

（none）

Sub GetImage(control

 As IRibbonControl,

ByRef returnedVal)

imageMso

getImage

1至1024个字符

（none）

同上

（none）

getItemCount

1至1024个字符

（none）

Sub GetItemCount(control

As IRibbonControl,

ByRef returnedVal)

（none）

getItemID

独立的文本字符串

（none）

Sub GetItemID(control

As IRibbonControl,

index As Integer,

ByRef id)

（none）

getItemImage

1至1024个字符

（none）

Sub GetItemImage(control

 As IRibbonControl,

index As Integer,

ByRef returnedVal)

（none）

getItemLabel

1至1024个字符

（none）

Sub GetItemLabel(control

As IRibbonControl,

index As Integer,

ByRef returnedVal)

（none）

getItemScreentip

1至1024个字符

（none）

Sub GetItemScreenTip(control

 As IRibbonControl,

index As Integer,

ByRef returnedVal)

（none）

getItemSupertip

1至1024个字符

（none）

Sub GetItemSuperTip(control

 As IRibbonControl,

index As Integer,

ByRef returnedVal)

keytip

getKeytip

1至3个字符

（none）

Sub GetKeytip(control

As IRibbonControl,

ByRef returnedVal)

label

getLabel

1至1024个字符

（none）

Sub GetLabel(control

 As IRibbonControl,

ByRef returnedVal)

screentip

getScreentip

1至1024个字符

（none）

Sub GetScreentip(control

 As IRibbonControl,

ByRef returnedVal)

（none）

getSelectedItemID

独立的文本字符串

（none）

Sub GetSelectedItemID(control

 As IRibbonControl,

ByRef returnedVal)

（none）

getSelectedItemIndex

1至1024个字符

（none）

Sub

 GetSelectedItemIndex(control

As IRibbonControl,

ByRef returnedVal)

showImage

getShowImage

true,false,1,0

true

Sub GetShowImage(control

 As IRibbonControl,

ByRef returnedVal)

showItemImage

（none）

true,false,1,0

true

（none）

ShowItemLabel

（none）

true,false,1,0

true

（none）

showLabel

getShowLabel

true,false,1,0

true

Sub GetShowLabel(control

 As IRibbonControl,

ByRef returnedVal)

sizeString

（none）

1至1024个字符

12

（none）

supertip

getSupertip

1至1024个字符

(none)

Sub GetSupertip(control

 As IRibbonControl,

ByRef returnedVal)

tag

(none)

1至1024个字符

(none)

(none)

visible

getVisible

true,false,1,0

true

Sub GetVisible(control

As IRibbonControl,

ByRef returnedVal)

（none）

onAction

1至1024个字符

（none）

Sub OnAction(control

 As IRibbonControl,

selectedId As String,

selectedIndex As Integer)

3、dropDown元素允许的子对象

dropDown元素可以使用的唯一的子对象是item元素。

4、dropDown元素的父对象

在下列任何控件内都能放置dropDown控件：

n         box

n         group

5、使用内置的下拉控件

下面引用Excel内置的边框样式控件。

（1）创建一个新的.xlsx文件，并将其保存为Excel Built In dropDown Example.xlsx。

（2）关闭该文件并在CustomUI Editor中打开。

（3）输入下列XML代码：

                 label=“Demo“

                 insertBeforeMso=“TabHome“>

                        label=“Demo“>

下图为上述代码创建的组。

6、创建自定义下拉控件

本示例相当有趣，因为前后使用了两个dropDown元素。与在介绍组合框控件示例时相似，第一个控件中列出了工作簿中的所有工作表。然而，在从工作簿中添加或移除工作表时，我们使用可用的回调来更新下拉列表，

第二个控件允许用户切换所选工作表的可见性：xlSheetVisible、xlSheetHidden和xlSheetVeryHidden。

（1）新建一个工作簿，以.xlsm为扩展名保存后关闭。

（2）在CustomUI Editor中打开该工作簿，并输入下列XML代码：

                 label=“Navigation“

                 insertBeforeMso=“TabHome“>

                        label=“Navigate To“>

                                  label=“Apply To:“

                                  visible=“true“

                                  onAction=“rxddSelectSheet_click“

                                  getItemID=“rxitemddSelectSheet_getItemId“

                                  getItemCount=“rxitemddSelectSheet_getItemCount“

                                  getItemLabel=“rxitemddSelectSheet_getItemLabel“/>

                                 label=“Set To:“

                                 onAction=“rxddSheetVisible_click“>

                                       label=“Visible“/>

                                       label=“Hidden“/>

                                       label=“VeryHidden“/>

生成回调签名，并复制代码后关闭CustomUI Editor。

在Excel中打开该工作簿，打开VBE并将回调签名代码粘贴到一个标准模块中。注意到，少生成了一个回调签名：getItemID，需要补充。

首先处理onLoad回调。在代码开始处添加两个变量，一个包含RibbonUI对象，另一个存放所选的工作表名：

Public RibbonUI As IRibbonUI

Dim sSheetName As String

接着，设置onLoad回调确保RibbonUI对象在装载时被捕获：

‘customUI.onLoad回调

Sub rxIRibbonUI_onLoad(ribbon As IRibbonUI)

    Set RibbonUI = ribbon

End Sub

下面的代码获取工作表数：

‘rxddSelectSheet getItemCount回调

Sub rxitemddSelectSheet_getItemCount(control As IRibbonControl, ByRef returnedVal)

    returnedVal = Worksheets.Count

End Sub

下一步，设置getItemLabel回调，返回下拉列表中每个项目的文本：

‘rxddSelectSheet getItemLabel回调

Sub rxitemddSelectSheet_getItemLabel(control As IRibbonControl, index As Integer, ByRef returnedVal)

    returnedVal = Worksheets(index + 1).Name

End Sub

注意到数组参数使用index+1，这是因为VBA默认的数组索引号基于0，而Excel默认的工作表索引是基于1。

接下来，确保为每个下拉项动态生成唯一的ID，回调代码如下：

Sub rxitemddSelectSheet_getItemID(control As IRibbonControl, index As Integer, ByRef id)

    id = “rxitemddSelectSheet” & index+1

End Sub

更新rxddSelectSheet_click过程如下：

‘rxddSelectSheet onAction回调

Sub rxddSelectSheet_click(control As IRibbonControl, id As String, index As Integer)

    On Error Resume Next

    Call rxitemddSelectSheet_getItemLabel(control, index, sSheetName)

    If Err.Number <> 0 Then

        MsgBox “Sorry,that worksheet does not exist!”

        RibbonUI.InvalidateControl “rxddSelectSheet”

    End If

End Sub

已经完成动态dropDown控件的设置后，再来为静态下拉列表设置唯一的回调：

‘rxddSheetVisible onAction回调

Sub rxddSheetVisible_click(control As IRibbonControl, id As String, index As Integer)

    ‘检查已选择的工作表

    On Error Resume Next

    sSheetName = Worksheets(sSheetName).Name

    If Err.Number <> 0 Then

        MsgBox “Sorry,but you need to select a valid sheet first!”

        Exit Sub

    End If

    ‘改变工作表的可见性

    Select Case id

        Case “rxitemddSheetVisible1″

            Worksheets(sSheetName).Visible = xlSheetVisible

        Case “rxitemddSheetVisible2″

            Worksheets(sSheetName).Visible = xlSheetHidden

        Case “rxitemddSheetVisible3″

            Worksheets(sSheetName).Visible = xlSheetVeryHidden

    End Select

    If Err.Number <> 0 Then

        MsgBox “Sorry,this is the only visible sheet.” & vbCrLf & “You cann’t hide the all!”

    End If

    On Error GoTo 0

End Sub

至此，全部代码已完成。可以测试了，如下图所示。