自定义功能区示例：创建用于工作表导航的下拉列表

标签：VBA，自定义功能区

我们可以自定义功能区，在上面设置我们想要的功能，从而方便我们对工作表或工作簿的操作。本文的示例如下图1所示，在功能区中添加一个自定义的选项卡，然后再该选项卡中添加带有下拉列表的一个自定义组，用于从下拉列表中选择工作表，从而快速导航到该工作表，这对于工作簿中有大量工作表且要快速找到相应的工作表的用户来说，非常有用。

图1

假设该工作簿名称为CustomUIDropdown.xlsm，使用Custom UI Editor for Microsoft Office打开该工作簿，在其中输入代码：

代码语言：javascript复制

<customUI  xmlns="http://schemas.microsoft.com/office/2009/07/customui" onLoad="RibbonOnLoad">
 <ribbon >
   <tabs >
     <tab id="Tab1" insertBeforeMso="TabHome" label="My Menu">
       <group id="grpDropDowns" label="Worksheet Navigation">
         <dropDown
            id="SheetNavigation"
            label="Navigate to:"
            sizeString="WWWWWWWWWW"
            supertip="Go to Worksheet Selected in Dropdown "
            getItemCount="getItemCount"
            getItemLabel="getItemLabel" 
            getSelectedItemIndex="GetSelectedItemIndexDropDown"
            onAction="onAction"/>
       </group >
     </tab >
   </tabs >
 </ribbon >
</customUI >

验证无误后，保存并关闭Custom UI Editor for Microsoft Office。

在Excel中打开CustomUIDropdown.xlsm，打开VBE，插入一个标准模块，输入下面的代码：

代码语言：javascript复制

Dim Rib As IRibbonUI
Private mwkbNavigation As Workbook
'Callback for SheetNavigation getItemCount
Sub getItemCount(control As IRibbonControl, ByRef returnedVal)
 Dim lCount As Long
 Dim wksSheet As Worksheet
 Set mwkbNavigation = ThisWorkbook
 For Each wksSheet In mwkbNavigation.Worksheets
   If wksSheet.Visible = xlSheetVisible Then
     lCount = lCount   1
   End If
 Next wksSheet
 returnedVal = lCount
End Sub
'Callback for SheetNavigation getSelectedItemIndex
Sub GetSelectedItemIndexDropDown(control As IRibbonControl, ByRef index)
 index = ActiveSheet.index - 1
End Sub
'Callback for SheetNavigation getItemLabel
Sub getItemLabel(control As IRibbonControl, index As Integer, ByRef returnedVal)
 If mwkbNavigation.Worksheets(index   1).Visible = xlSheetVisible Then
   returnedVal = mwkbNavigation.Worksheets(index   1).Name
 End If
End Sub
'Callback for SheetNavigation onAction
Sub onAction(control As IRibbonControl, id As String, index As Integer)
 Dim sSheetName As String
 sSheetName = mwkbNavigation.Worksheets(index   1).Name
 mwkbNavigation.Worksheets(sSheetName).Activate
End Sub
Sub RibbonOnLoad(ribbon As IRibbonUI)
 Set Rib = ribbon
End Sub

保存并关闭该工作簿，然后重新打开该工作簿，即可以看到更新后的自定义功能区界面。

callback label ribbon worksheet 工作

0 人点赞