VBA一键生成带超链接的工作表目录

2023-12-20 04:58:59

前言

一个Excel工作簿，可能包含多个工作表；这时我们就希望能有一个工作表目录，一方面，可以纵览簿里有多少表、都是什么名字，另一方面，也可以通过超链接快速查看相关工作表的内容。那么说起制作工作表目录来，您首先想到的是什么？函数？厉害！不愧是函式高手。不过我们今天不是要讲函数，而是利用VBA代码快速生成带超链接的工作表目录。

代码实现

在开始之前，我们先看一下最终效果图，如图1所示。

工作表目录效果图

图1 工作表目录效果图

现在，我们开始编写代码。首先，按Alt+F11打开VBA编辑器，然后在插入菜单中选择“模块”。在弹出的模块窗口中，输入如下代码：

Sub 生成工作表目录()
    Dim wb As Workbook
    Dim wsNew As Worksheet
    Dim rngCell As Range

    '获取当前工作簿
    Set wb = ActiveWorkbook

    '添加新工作表
    Set wsNew = wb.Worksheets.Add

    '设置工作表名称
    wsNew.Name = "工作表目录"

    '设置单元格样式
    With wsNew.Range("A1:B1")
        .MergeCells = True
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Font.Bold = True
        .Interior.ColorIndex = 15
    End With

    '填充标题
    wsNew.Range("A1").Value = "工作表目录"

    '获取工作表名称
    Dim arrSheets() As String
    For i = 1 To wb.Worksheets.Count
        ReDim Preserve arrSheets(i - 1)
        arrSheets(i - 1) = wb.Worksheets(i).Name
    Next i

    '填充工作表名称
    wsNew.Range("A2").Resize(wb.Worksheets.Count, 1).Value = arrSheets

    '设置超链接
    For i = 2 To wb.Worksheets.Count + 1
        rngCell = wsNew.Cells(i, 1)
        rngCell.Hyperlinks.Add Anchor:=rngCell, Address:="'" & wb.Worksheets(i - 1).Name & "'!A1", TextToDisplay:=rngCell.Value
    Next i

    '调整列宽
    wsNew.Columns("A:B").AutoFit

    '显示工作表目录
    wsNew.Activate
End Sub