Excel一键生成目录，爆肝两小时，通用版！

哈喽！大家好，我是E精精~

今天我们继续分享目录制作，前面我们分享了WPS中的实现和Excel中函数模版法，今天我们分享VBA一键搞定，通用！

制作目录，首先我们要判断工作表中是否有【目录导航】这张表，一般都没有，如果没有代码自动创建一个吧，就不用大家手工去创建了，这样通用性才更好！

01 - 自动创建目录导航表

▼ 全自动生成目录导航表

代码首先判断【目录导航】表是否存在，如果存在就清空内容，方便我们下一步使用，如果不存在就在当前文档中的第一个表前插入一个表，并修改名称为【目录导航】，代码全自动处理，无需任何人工干预！

导航表有了之后，我们就把全部表名称添加到【目录导航】表中，并添加超链接，方便我们跳转！

02 - 超链接目录制作

▼ 自动生成目录带跳转

这里主要知识点就 For Each循环和写入单元格，这些都是VBA基础知识！

我们自己使用，直接按照上图，点击对应的宏直接运行就会自动生成！

▼ 完整代码

现在已经实现了自动生成，但是有的同学就反馈说，能不能在每个表中添加一个【返回目录】的功能，下面我们就来实现！

03 - 返回目录功能

▼ 自动生成返回目录

返回目录这里主要使用图形来做，这样可以在保证不破坏数据的情况，在每个表中都添加一个返回目录的图形，点击快速返回，如果有遮挡，还可以拖动图形位置来处理！

▼ 完整代码

现写，爆肝两小时，终于全部搞定，下面我们整理一下代码，把三个功能整合一下，大家点击【一键目录】即可一键搞定，不用做任何处理！

04 - 完整源码（已整合）

再添加一个过程，依次调用上面三步，我们只需要执行这个过程即可一键搞定

▼完整源码如下：左右滑动查看，一键复制使用

Option Explicit
'功能：创建【目录导航】工作表'作者：E精精'----------------------------------------------Sub 创建目录工作表() Dim ct_sht As Worksheet On Error Resume Next Set ct_sht = Worksheets('目录导航') '存在就清空，不存在创建一个 If Err.Number = 0 Then ct_sht.Cells.Clear Else ThisWorkbook.Worksheets.Add Before:=Worksheets(1) ActiveSheet.Name = '目录导航' End IfEnd Sub
'功能: 生成带超链接的工作表目录'作者：E精精'----------------------------------------------Sub 超链接目录() Dim sht As Worksheet, n As Long With Sheets('目录导航') '标题 .[A1:b1] = Array('序号', '工作表名称') .Columns(1).HorizontalAlignment = XlHAlign.xlHAlignCenter '循环添加到目录导航表中 For Each sht In ThisWorkbook.Worksheets If sht.Name <> '目录导航' Then n = n + 1 .Cells(n + 1, 1) = n '添加超链接 .Hyperlinks.Add .Cells(n + 1, 2), '', _ ''' & sht.Name & ''!A1', , sht.Name .Cells(n + 1, 2).Font.Underline = False End If Next End WithEnd Sub

'功能: 每个表中返回目录功能

Option Explicit
'功能：创建【目录导航】工作表'作者：E精精'----------------------------------------------Sub 创建目录工作表()    Dim ct_sht As Worksheet    On Error Resume Next    Set ct_sht = Worksheets('目录导航')    '存在就清空，不存在创建一个    If Err.Number = 0 Then        ct_sht.Cells.Clear    Else        ThisWorkbook.Worksheets.Add Before:=Worksheets(1)        ActiveSheet.Name = '目录导航'    End IfEnd Sub
'功能: 生成带超链接的工作表目录'作者：E精精'----------------------------------------------Sub 超链接目录()    Dim sht As Worksheet, n As Long       With Sheets('目录导航')        '标题         .[A1:b1] = Array('序号', '工作表名称')         .Columns(1).HorizontalAlignment = XlHAlign.xlHAlignCenter         '循环添加到目录导航表中         For Each sht In ThisWorkbook.Worksheets             If sht.Name <> '目录导航' Then                 n = n + 1                 .Cells(n + 1, 1) = n                 '添加超链接                 .Hyperlinks.Add .Cells(n + 1, 2), '', _                 ''' & sht.Name & ''!A1', , sht.Name                                  .Cells(n + 1, 2).Font.Underline = False             End If         Next     End WithEnd Sub

'功能: 每个表中返回目录功能'作者：E精精'----------------------------------------------Sub 返回目录()    Dim shp As Shape, sht As Worksheet    For Each sht In Sheets        If sht.Name <> '目录导航' Then            '删除原有的            For Each shp In sht.Shapes                If shp.Name = sht.Name Then                    shp.Delete                End If            Next            '重新添加            Set shp = sht.Shapes.AddShape(msoShapeRectangle, 15, 15, 80, 20)            sht.Activate            With shp                .Name = sht.Name                .Select                .TextFrame2.TextRange.Text = '返回目录'            End With                        sht.Hyperlinks.Add Selection.ShapeRange.Item(1), '', '目录导航!A1'                       End If    Next    Sheets('目录导航').ActivateEnd Sub

Sub 一键目录()    '调用生成 目录导航工作表功能    Call 创建目录工作表        '调用生成目录超链接    Call 超链接目录        '添加返回目录功能    Call 返回目录    End Sub