VBA-超链接到隐藏的工作簿中的现有工作表



我根据单元格的值将其超链接到工作簿中的现有工作表。它贯穿 B 列,对于单词"title"的任何实例,它会在其正下方的单元格中放置一个超链接。其正下方单元格中的字符串与相应的工作表名称相同。该脚本运行良好,但是如果工作表被隐藏,它将无法打开它。谁能建议如何解决这个问题?

'循环访问指定的列,当找到指定的值时,在下面的单元格中放置一个超链接

Const cWsName As String = "Title Detail"
Const cSearch As String = "Title"
Const cRow1 As Integer = 1
Const cRow2 As Long = 200
Const cCol As String = "B"
Dim oWb As Workbook
Dim oWs As Worksheet
Dim rCell1 As Range
Dim rCell2 As Range
Dim iR As Integer
Dim strText As String
Dim strAddr As String
Set oWb = ActiveWorkbook
Set oWs = oWb.Worksheets(cWsName)
For iR = cRow1 To cRow2
Set rCell1 = oWs.Range(cCol & iR)
Set rCell2 = oWs.Range(cCol & iR + 1)
strText = rCell2.Text 'What's written in the cell.
strAddr = rCell2.Address 'The address e.g. B1, B13 ...
If rCell1 = cSearch Then
If strText <> "" Then
'Anchor is the place where to put the hyperlink, cell or object.
'Notice the single quotes (') in the SubAddress.
rCell2.Hyperlinks.Add _
Anchor:=rCell2, _
Address:="", _
SubAddress:="'" & rCell2 & "'!" & "A1", _
TextToDisplay:=strText 'The same text as requested
Else
'what to do if the cell below the Title cell is empty.
End If
End If
Next
'End on Title Detail Sheet
oWb.Sheets("Title Detail").Select
End Sub

私有子Worksheet_FollowHyperlink(ByVal Target as hyperlink(

Dim oWs As Workbook
Dim targetString As String, targetSheet As Worksheet
Set oWs = ActiveWorkbook 
targetString = Target.TextToDisplay 
Set targetSheet = oWs.Worksheets(targetString)
If targetSheet.Visible = False Then
targetSheet.Visible = True
End If

'标题详细信息表结束 目标工作表。选择

结束子

正如我在回答您删除的类似问题时指出的那样:

请注意,您需要显式调用 。如果工作表被隐藏,请跟随。

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim oWs As Worksheet
Dim targetString As String, targetSheet As Worksheet
Set oWs = ActiveWorkbook
targetString = Target.TextToDisplay
Set targetSheet = oWs.Sheets(targetString)
If targetSheet.Visible = False Then
targetSheet.Visible = True
'If the sheet was hidden, you have to explicitly follow the link again.
Application.EnableEvents = False
Target.Follow
Application.EnableEvents = True
End If
End Sub

最新更新