VBA - гиперссылка на скрытый лист в книге, который скрыт - PullRequest
0 голосов
/ 28 сентября 2018

Я создаю гиперссылку ячеек на основе их значений на существующие листы в моей книге.Он проходит через столбец B и для любого экземпляра слова «заголовок» размещает гиперссылку в ячейке непосредственно под ним.Строка в ячейке непосредственно под ней совпадает с именем соответствующего листа.Сценарий работает отлично, однако, если лист скрыт, он не откроется.Может кто-нибудь посоветовать, как решить для этого?

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...