MS Excel 2003: extraer direcciones de hipervínculos (archivos y URL)

Los datos expuestos en este blog, son solo de índole informativo. Por favor realiza siempre una copia de seguridad antes de realizar cualquier cambio en tu proyecto.

MS Excel 2003: extraer direcciones de hipervínculos (archivos y URL)

Este tutorial de Excel muestra cómo escribir macros (con capturas de pantalla e instrucciones paso a paso) para extraer archivos y direcciones de hipervínculos web en Excel 2003 y versiones anteriores.

P: En Microsoft Excel 2003/XP/2000/97, tengo una hoja de cálculo que contiene direcciones de hipervínculos a archivos. Intento extraer las direcciones de hipervínculo de estos archivos, pero no obtengo las direcciones completas. La dirección completa debe ser:

C:My DocumentsPast ProjectsCentennialProgram Status Report.xls

pero solo obtengo:

....Past ProjectsCentennialProgram Status Report.xls

¿Hay alguna forma de obtener siempre la dirección completa del hipervínculo?

Respuesta: aquí hay dos funciones que puede incluir en su hoja de cálculo para extraer la dirección completa del hipervínculo documento o un URL.

Function HyperLinkText(pRange As Range) As String

   Dim ST1 As String
   Dim ST2 As String
   Dim LPath As String
   Dim ST1Local As String

   If pRange.Hyperlinks.Count = 0 Then
      Exit Function
   End If

   LPath = ThisWorkbook.FullName

   ST1 = pRange.Hyperlinks(1).Address
   ST2 = pRange.Hyperlinks(1).SubAddress

   If Mid(ST1, 1, 15) = ".........." Then
      ST1Local = ReturnPath(LPath, 5) & Mid(ST1, 15)
   ElseIf Mid(ST1, 1, 12) = "........" Then
      ST1Local = ReturnPath(LPath, 4) & Mid(ST1, 12)
   ElseIf Mid(ST1, 1, 9) = "......" Then
      ST1Local = ReturnPath(LPath, 3) & Mid(ST1, 9)
   ElseIf Mid(ST1, 1, 6) = "...." Then
      ST1Local = ReturnPath(LPath, 2) & Mid(ST1, 6)
   ElseIf Mid(ST1, 1, 3) = ".." Then
      ST1Local = ReturnPath(LPath, 1) & Mid(ST1, 3)
   Else
      ST1Local = ST1
   End If

   If ST2 <> "" Then
      ST1Local = "[" & ST1Local & "]" & ST2
   End If

   HyperLinkText = ST1Local

End Function

Function ReturnPath(pAppPath As String, pCount As Integer) As String

   Dim LPos As Integer
   Dim LTotal As Integer
   Dim LLength As Integer

   LTotal = 0
   LLength = Len(pAppPath)

   Do Until LTotal = pCount + 1
      If Mid(pAppPath, LLength, 1) = "" Then
         LTotal = LTotal + 1
      End If
      LLength = LLength - 1
   Loop

   ReturnPath = Mid(pAppPath, 1, LLength)

End Function

Luego puede hacer referencia a estas nuevas características en su hoja de cálculo.

Por ejemplo, en la celda B1 podrías ingresar lo siguiente:

=HyperLinkText(A1)