VBA 工作表生成超链接目录

Sub Sht_HyperLinks() '工作表超链接
    Dim Sht As Worksheet, ActSht As Worksheet, Cell As Range, intx&, YesNo&
    Set Cell = 模块.SetRng("请选择放置的单元格" & Chr(10) & "注意:下方如有数据有可能会被覆盖!!") '用户选择放置的单元格
    If Cell Is Nothing Then MsgBox "请重新选择", 64, "提示!": Exit Sub
    YesNo = MsgBox("是否使用超链接", vbYesNo, "提示:") '用户选择是否使用超链接
    Cell(1).Value = "目录" '第一个单元格写入目录
    Set ActSht = ActiveSheet '当前工作表
    Application.ScreenUpdating = False '屏蔽闪屏
    With ActSht
        For Each Sht In Sheets '循环遍历工作表
            If Sht.Name <> .Name Then '不等于当前工作表名称的时候
                intx = intx + 1 '计数器累加
                If YesNo = 6 Then '如果是需要超链接
                    .Hyperlinks.Add .Cells(Cell.Row + intx, Cell.Column), "", "'" & Sht.Name & "'!A1", "点击跳转至<" & Sht.Name & ">A1单元格", Sht.Name
                Else
                    .Cells(Cell.Row + intx, Cell.Column) = Sht.Name '不使用超链接只写表名
                End If
            End If
        Next
    End With
    Application.ScreenUpdating = True '恢复系统设置
End Sub
复制

Hyperlinks.Add (Anchor,Address,SubAddress,Screentip,TextToDisplay)
复制

.Hyperlinks.Add .Cells(Cell.Row + intx, Cell.Column), "", "'" & Sht.Name & "'!A1", "点击跳转至<" & Sht.Name & ">A1单元格", Sht.Name
复制

.Hyperlinks.Add 存放位置,超链接地址,超链接的子地址,文字说明,显示的内容
复制