提取工作表名建立目录超级链接vba
'参考代码: 代码放在ThisWorkbook内
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If ActiveSheet.Name = "menu" Then Exit Sub
With Sheets("menu")
.Range("A2:B" & Rows.Count).ClearContents
Dim x As Integer
For x = 1 To Sheets.Count
If Sheets(x).Name <> Sheets("menu").Name Then
.Cells(x, 1) = x - 1
.Cells(x, 2) = Sheets(x).Name
ActiveSheet.Hyperlinks.Add Anchor:=.Cells(x, 2), Address:="", SubAddress:=Sheets(x).Name & "!A1"
End If
Next
End With
End Sub
Private Sub Workbook_Open()
'提取各个工作表标签名称并在第一页建立目录和超级链接的程序
Dim mysheet As Worksheet
Dim Rowindex_1, Columndex_1, StartRowindex As Integer
Dim j As String
Rowindex_1 = 2 ''''定义菜单起始行数
Columndex_1 = 2 ''''定义菜单所在列
StartRowindex = Rowindex_1
Sheets(1).Select
Columns(Columndex_1).ClearContents
Columns(Columndex_1).NumberFormatLocal = "@"
For Each mysheet In Worksheets
If Rowindex_1 = StartRowindex Then
Cells(Rowindex_1 - 1, Columndex_1) = "菜单"
Else
Cells(Rowindex_1 - 1, Columndex_1).Select
Selection = mysheet.Name
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=mysheet.Name & "!a1", TextToDisplay:=mysheet.Name '建立超级链接
End If
Rowindex_1 = Rowindex_1 + 1
Next mysheet
End Sub