如何用vba创建工作表目录以及返回目录超链接?

要用vba创建工作表目录和返回目录超链接,步骤可以如下:

  1. 首先新建一个工作表,在新建的工作表中创建其它工作表的目录超链接。
  2. 在其它工作表中任意位置插入图形,创建返回工作表目录的超链接。

同时,为了考虑程序的多次重复使用不出错,还需要考虑到每次执行程序时要注意以下几点:

  1. 每次运行程序要删除原来的工作表目录和超链接
  2. 每次运行程序要删除原来的返回工作表目录图片和超链接

基于以上的分析,可以使用如下的通用代码生成工作表目录的超链接:

Function WorkSheetExists(oWB As Workbook, ByVal sWkName As String) As Boolean
    '判断指定名称的工作表是否存在
    'QQ1722187970
    'oWB为具体的工作簿,sWkName为工作表的名称,结果返回True表示存在
    On Error Resume Next
    Dim oWK As Worksheet
    Set oWK = oWB.Worksheets(sWkName)
    '如果出错表示不存在指定名称的工作表
    If Err.Number <> 0 Then
        WorkSheetExists = False
    Else
        WorkSheetExists = True
    End If
    Err.Clear
End Function
Sub QQ1722187970()
    Excel.Application.DisplayAlerts = False
    On Error Resume Next
    Dim oWK As Worksheet
    Dim oWB As Workbook
    Dim oSp As Shape
    Set oWB = Excel.ActiveWorkbook
   If WorkSheetExists(oWB, "导航目录") = False Then
        Set oWK = oWB.Worksheets.Add(Excel.Worksheets(1))
        oWK.Name = "导航目录"
        oWK.Range("a1") = "目录"
   Else
        Set oWK = oWB.Worksheets("导航目录")
        oWK.Delete
        Set oWK = oWB.Worksheets.Add(Excel.Worksheets(1))
        oWK.Name = "导航目录"
        oWK.Range("a1") = "目录"
   End If
   Dim oWK1 As Worksheet
   i = 2
   For Each oWK1 In oWB.Worksheets
        Dim oRng As Range
        If oWK1.Name <> oWK.Name Then
            oWK1.Shapes("超链接").Delete
            Set oRng = oWK.Range("a" & i)
            sAddress = oWK1.Range("a1").Address(, , , True)
            oWK.Hyperlinks.Add oRng, "", sAddress, , oWK1.Name
            Set oSp = oWK1.Shapes.AddShape(msoShapeBalloon, 0, 0, 50, 30)
            oWK1.Hyperlinks.Add oSp, "", oWK.Range("a1").Address(, , , True), , ""
            oSp.Name = "超链接"
            oSp.TextFrame2.TextRange.Text = "返回"
            i = i + 1
        End If
   Next
   Excel.Application.DisplayAlerts = True
End Sub

 

       

发表评论