要用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
发表评论