Extraer URL (Categoria: UDF-macros)(Autor:ST_)

[verzulsan]

Hoy me ha vuelto a hacer falta esta magnifica UDF para extraer facilmente multiples enlaces de URL, aportada por el maestro ST_ en su día, en una de esas respuestas que caen en el olvido, y que deberia estar en el hilo de aportes por su gran utilidad.

No adjunto el arhcivo sino que pongo el enlace directo, el archivo con la UDF esta en la primera respuesta del post.

Ir al post

PD: Al final del post, pone una mejora de la UDF.

Un saludo amigo ST_

EDITADO: Adjunto mi propia version para extraer la URL:

Function VerURL(rango) As String

    On Error GoTo NoLink

    VerURL = rango.Hyperlinks(1).Address

    Exit Function

NoLink:

    VerURL = ""

End Function[/CODE]

Y ahora un proceso donde transpasamos los links a otra columna, dejando la primera con el texto solo y la segunda con el hipervinculo en forma de texto:

[CODE]'Transpasa el hipervinculo de la columna 1 a la columna 2 en forma de texto
Sub TranspasarHyperlinks()
For Each celda In Intersect(Columns(1), ActiveSheet.UsedRange)
If Not (VerURL(celda)) = "" Then
Cells(celda.Row, 2) = VerURL(celda)
celda.Hyperlinks.Delete
End If
Next
End Sub[/CODE]

[Antoni]

Hola:

Haciendome eco de los deseos de _ST, he aligerado un poco la macro:

Function Mire_la_URL_II(rango) As String

If rango.HasFormula = True Then

   Mire_la_URL_II = Split(rango.FormulaLocal, """")(1)

Else

For Each h In ActiveSheet.Hyperlinks

    If h.Range.Address = [rango].Address Then Txt = h.Address

Next

    Mire_la_URL_II = Txt

End If

End Function

[/CODE]

Saludos y "viva er Beti"

[ST_]

......Haciendome eco de los deseos de _ST, he aligerado un poco la macro.........Saludos y "viva er Beti"

siempre se agradecen las mejoras

[verzulsan]

Mi propia versión de la función que extrae la URL de las celdas:

Function VerURL(rango) As String

    On Error GoTo NoLink

    VerURL = rango.Hyperlinks(1).Address

    Exit Function

NoLink:

    VerURL = ""

End Function[/CODE]

Actualizado en primer post.

Saludos.