一、问题：当我们在做表的时候，有的时候一个工作簿会有很多表，这个时候切换或查找表格可能会麻烦。
二、需求：在功能区自动生成菜单目录，或分类生成目录方便选择和查找对应的表。
三、实现：
1、先写功能区UI代码，具体怎么放，大家看一下源文件。
UI代码和文件分享
链接：https://pan.baidu.com/s/1RDL_xyzDsEmg81kpKJiRAA
提取码：gwca
<?xml version="1.0" encoding="GBK" ?>
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" onl oad="QH_LOAD" >
<ribbon startFromScratch="false">
<tabs>
<tab id="qh_t1" label="QH_表菜单" insertBeforeMso="TabHome" >
<group id="qh_g1" label="作者:阙辉" >
<dynamicMenu id="qh001" label="所有目录" image="QH_01" size="large" tag="ALL" getContent="qh_contentts" />
</group>
<group id="qh_g2" label="********" >
<dynamicMenu id="qh002" label="S类目录" image="QH_01" size="large" tag="S" getContent="qh_contentts" />
</group>
<group id="qh_g3" label="********" >
<dynamicMenu id="qh003" label="Q类目录" image="QH_01" size="large" tag="Q" getContent="qh_contentts" />
</group>
<group id="qh_g4" label="********" >
<dynamicMenu id="qh004" label="H类目录" image="QH_01" size="large" tag="H" getContent="qh_contentts" />
</group>
</tab>
</tabs>
</ribbon>
</customUI>2、写功能代码：
思路：
A. 先获取主菜单tag，
B.如果tag为ALL则获取所有表名，并拼接菜单xml代码
C. 如果tag不为ALL说明需要分类获取表名，并拼接菜单xml代码
D.输出拼接好的菜单xml代码
Function qh_get_sheet_menu_class(qh_class0) '分类获取目录 作者：阙辉 2021.2.8 使用的是这个
Dim qh_n, qh_satr_row, qh_cloumn, i As Long
Dim qh_c_name, qh_class, qh_sheet_class
qh_class = qh_class0
qh_n = Sheets.Count
qh_id = 0
QH_XL = "<menu xmlns=""http://schemas.microsoft.com/office/2006/01/customui"">" 'XML代码拼接初始化
For i = 1 To qh_n
qh_menu_name = Sheets(i).Name
qh_sheet_class = Split(qh_menu_name, "_")(0) '截取"_"用作分类判断
If qh_class = "ALL" Then '如果tag为all则全部获取 阙辉
QH_XL = QH_XL & "<button id=""qh_fil" & qh_id & _
""" label=""" & qh_menu_name & _
""" image=""QH_02"" tag=""" & qh_menu_name & _
""" onAction=""QH_ON001"" />"
qh_id = qh_id + 1
ElseIf qh_sheet_class = qh_class Then '如果tag不为all则根据表名的_前面字母判断 阙辉
QH_XL = QH_XL & "<button id=""qh_fil" & qh_id & _
""" label=""" & qh_menu_name & _
""" image=""QH_02"" tag=""" & qh_menu_name & _
""" onAction=""QH_ON001"" />"
qh_id = qh_id + 1
End If
Next
QH_XL = QH_XL & "</menu>" 'XML代码结束
qh_get_sheet_menu_class = QH_XL
End Function3、菜单UI代码和VBA回调
Dim myribbon As IRibbonUI
'Callback for customUI.onLoad 打开时加载回调代码
Sub QH_LOAD(ribbon As IRibbonUI)
Set myribbon = ribbon
End Sub
'Callback for dynam2 getContent 更新表菜单回调代码
Sub qh_contentts(control As IRibbonControl, ByRef returnedVal)
Dim qh_class, QH_XL
qh_class = control.Tag
QH_XL = qh_get_sheet_menu_class(qh_class)
returnedVal = QH_XL
End Sub
操作目录回调代码 点谁就到谁
Sub QH_ON001(control As IRibbonControl)
Dim qh_sheet_name
myribbon.Invalidate
qh_sheet_name = control.Tag
Application.ScreenUpdating = False
Sheets(qh_sheet_name).Activate
Application.ScreenUpdating = True
'& vbCrLf
End Sub