我将单元格基于其值的超链接链接到我的工作簿中的现有工作表。它贯穿B列,对于“ title”一词的任何实例,它都将超链接直接放置在其下方的单元格中。单元格正下方的字符串与相应的工作表名称相同。该脚本可以完美运行,但是如果隐藏了工作表,它将无法打开它。谁能建议如何解决这个问题?
Sub HyperlinkBColumn()
'Description:
' Loops through a specified column and when a specified value is found, puts
' a hyperlink in the cell below.
'Arguments
' None
'Returns
' Hyperlinks on worksheet, Debugging info in the Immediate Window
'
'--Customize BEGIN ---------------------
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"
Const cHeader As String = "Processing rows..." 'Immdediate Window
Const cFooter As String = "...finished processing." 'Immediate Window
'--Customize END -----------------------
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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
Dim str1 As String 'Immediate Window
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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
str1 = str1 & vbCrLf & iR & ". " & rCell1.Address & " " _
& strText & " - at " & strAddr 'Immediate Window
Else
'Put in here what to do if the cell below the Title cell is empty.
'I've chosen to skip the line.
End If
End If
Next
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End Sub