代码语言:javascript复制
Sub GenerateTableOfContents()
Dim ws As Worksheet
Dim tocSheet As Worksheet
Dim lastRow As Long
Dim i As Long
' 获取目录工作表
Set tocSheet = ThisWorkbook.Sheets("目录工作表")
' 清除目录工作表原有内容
tocSheet.Cells.ClearContents
' 在目录工作表中设置标题
tocSheet.Range("A1").Value = "工作表"
tocSheet.Range("B1").Value = "位置"
' 初始化行号
lastRow = 2
' 遍历所有工作表
For Each ws In ThisWorkbook.Sheets
' 排除目录工作表本身
If ws.Name <> tocSheet.Name Then
' 在目录工作表中记录工作表名称和链接位置
tocSheet.Cells(lastRow, 1).Value = ws.Name
tocSheet.Hyperlinks.Add Anchor:=tocSheet.Cells(lastRow, 2), _
Address:="", SubAddress:="'" & ws.Name & "'!A1", TextToDisplay:="跳转"
' 增加行号
lastRow = lastRow 1
End If
Next ws
' 格式化目录表格
With tocSheet.Range("A1:B" & lastRow - 1)
.Font.Bold = True
.Columns.AutoFit
.Borders.LineStyle = xlContinuous
End With
' 在目录工作表中选择标题单元格
tocSheet.Range("A1").Select
' 提示生成目录完成
MsgBox "目录已生成。"
End Sub