vba给workbook多工作表添加跳转链接及回跳链接

 1 Sub CreateHyperlinks()
 2     Dim wb As Workbook
 3     Dim ws As Worksheet
 4     Dim newSheet As Worksheet
 5     Dim sheetNames() As String
 6     Dim i As Integer
 7     Dim linkAddress As String
 8     Dim returnCell As Range
 9     Dim maxColumn As Integer
10     Dim hyperlinkToNewSheet As Hyperlink
11     
12     '打开现有的工作簿
13     Set wb = Workbooks.Open("your_file.xlsx")
14     
15     '获取工作表名称
16     ReDim sheetNames(1 To wb.Sheets.Count)
17     For i = 1 To wb.Sheets.Count
18         sheetNames(i) = wb.Sheets(i).Name
19     Next i
20     
21     '添加新工作表并移至第一位
22     Set newSheet = wb.Sheets.Add(Before:=wb.Sheets(1))
23     newSheet.Name = "New Worksheet"
24     
25     '在新工作表中添加跳转链接
26     For i = 2 To UBound(sheetNames)
27         linkAddress = "'" & sheetNames(i) & "'!A1"
28         newSheet.Cells(i, 1).Value = "跳转到 " & sheetNames(i)
29         newSheet.Cells(i, 1).Hyperlinks.Add Anchor:=newSheet.Cells(i, 1), Address:="", SubAddress:=linkAddress, TextToDisplay:="跳转到 " & sheetNames(i)
30         
31         '在其他工作表中添加返回链接
32         Set ws = wb.Sheets(sheetNames(i))
33         maxColumn = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
34         Set returnCell = ws.Cells(1, maxColumn + 1)
35         returnCell.Value = "返回总表"
36         Set hyperlinkToNewSheet = ws.Hyperlinks.Add(Anchor:=returnCell, Address:="", SubAddress:="'" & newSheet.Name & "'!A" & i, TextToDisplay:="返回总表")
37     Next i
38     
39     '保存工作簿
40     wb.Save
41     wb.Close
42     Set wb = Nothing
43 End Sub