Excel 目录管理（ExcelVBA开发）

一、问题：当我们在做表的时候，有的时候一个工作簿会有很多表，这个时候切换或查找表格可能会麻烦。

二、需求：在功能区自动生成菜单目录，或分类生成目录方便选择和查找对应的表。

三、实现：

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 Function

3、菜单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

结果文件分享

链接：https://pan.baidu.com/s/13bouO33ITCJGmPL48BmDqA 
提取码：9qvc 
 

标签：sheet,XL,ExcelVBA,代码,Excel,class,QH,qh,目录
来源： https://blog.csdn.net/qh0526wy/article/details/113766419