viernes, julio 17, 2015

Función que genera hipervínculos a las pestañas del Libro si estas existen.

'UTIL
Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
   On Error Resume Next
      WorksheetExists = (Sheets(WorksheetName).Name <> "")
   On Error GoTo 0
End Function


Sub GenHyperlinks()
     Dim i As Long
     Sheets("Taller").Activate
     i = 2
     'El link va en el primer registro de la tabla
     While Range("A" & i).Value <> ""
        If Range("D" & i).Value = "1" Then
           'Si ya tiene enlace no recrear
           If Range("A" & i).Hyperlinks.Count = 0 Then
              'Si la hoja existe crear el enlace
              If WorksheetExists(Range("A" & i).Value) Then
                 'Create link
                 Range("A" & i).Hyperlinks.Add _
                 Anchor:=Range("A" & i), _
                 Address:="", _
                 SubAddress:=Range("A" & i).Value & "!A1", _
                 ScreenTip:=Range("A" & i).Value, _
                 TextToDisplay:=Range("A" & i).Value
              End If
           End If
        End If
        i = i + 1
        DoEvents
     Wend
End Sub


No hay comentarios: