要用vba创建工作表目录和返回目录超链接,步骤可以如下:
- 首先新建一个工作表,在新建的工作表中创建其它工作表的目录超链接。
- 在其它工作表中任意位置插入图形,创建返回工作表目录的超链接。
同时,为了考虑程序的多次重复使用不出错,还需要考虑到每次执行程序时要注意以下几点:
- 每次运行程序要删除原来的工作表目录和超链接
- 每次运行程序要删除原来的返回工作表目录图片和超链接
基于以上的分析,可以使用如下的通用代码生成工作表目录的超链接:
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


发表评论