提取工作表名建立目录超级链接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

(0)

相关推荐