Apagada docs

Este programa es una macro para office 2003 (ignoro si funcionará en office más modernos) que permite dividir los links de forma que sean más legibles, y que además coloca comillas angulares simples (‹›) a su alrededor, como se haría en una cita bibliográfica.

(Probablemente se podría portar a Open Office Basic si supiera qué objeto utilizar en lugar de hyperlink y ThisDocument.hyperlinks)

Attribute VB_Name = "Arreglar_Link_v2"
 
'
'Añade espacios de separación en el texto de los hipervínculos,
'pero se asegura de que no se añadan en el URI
'(si se hace a mano, se añaden en el URI)
'
Sub arreglalink_todo()
Dim t As String, u As String
Dim finpalabra As String
Dim c As String
Dim i2 As Integer, f As Integer
 
Dim h As Hyperlink
finpalabra = "/?+._"
 
For Each h In ThisDocument.Hyperlinks
    t = h.TextToDisplay
    u = h.Address
    'borrar todos los caracteres de separación de t
    i2 = InStr(t, ChrW(8204))
    While i2 > 0
        t = Left(t, i2 - 1) + Mid(t, i2 + 1)
        i2 = InStr(t, ChrW(8204))
    Wend
 
    'Añadir caracteres de separación tras todos los de finpalabra
    For f = 1 To Len(finpalabra)
        c = Mid(finpalabra, f, 1)
        i2 = InStr(t, c)
        While i2 > 0
        'Si el siguiente carácter es igual, no reemplaza.
        If Mid(t, i2 + 1, 1) <> c Then
            t = Left(t, i2) + ChrW(8204) + Mid(t, i2 + 1)
            i2 = InStr(i2 + 1, t, c)
        Else
            i2 = i2 + 1
        End If
        Wend
    Next
 
    'borrar todos los caracteres de separación de u
    i2 = InStr(u, ChrW(8204))
    While i2 > 0
        u = Left(u, i2 - 1) + Mid(u, i2 + 1)
        i2 = InStr(u, ChrW(8204))
    Wend
 
    Debug.Print u
    '&2039, &203A: comilla angular simple.
    If Left(t, 1) <> ChrW(&H2039) Then t = ChrW(&H2039) & t
    If Right(t, 1) <> ChrW(&H203A) Then t = t & ChrW(&H203A)
    'Evita separación al final
    If Right(t, 2) = ChrW(8204) + ChrW(&H203A) Then t = Left$(t, Len(t) - 2) & ChrW(&H203A)
    h.TextToDisplay = t
    h.Address = u
 
    Debug.Print t
Next
End Sub
'Añade espacios de separación en el texto de los hipervínculos,
'pero se asegura de que no se añadan en el URI
'(si se hace a mano, se añaden en el URI)
'
Sub arreglalink_seleccion()
 
Dim t As String, u As String
Dim finpalabra As String
Dim c As String
Dim i2 As Integer, f As Integer
 
Dim h As Hyperlink
finpalabra = "/?+"
 
For Each h In Selection.Hyperlinks
    t = h.TextToDisplay
    u = h.Address
    'borrar todos los caracteres de separación de t
    i2 = InStr(t, ChrW(8204))
    While i2 > 0
        t = Left(t, i2 - 1) + Mid(t, i2 + 1)
        i2 = InStr(t, ChrW(8204))
    Wend
 
    'Añadir caracteres de separación tras todos los de finpalabra
    For f = 1 To Len(finpalabra)
        c = Mid(finpalabra, f, 1)
        i2 = InStr(t, c)
        While i2 > 0
        'Si el siguiente carácter es igual, no reemplaza.
        If Mid(t, i2 + 1, 1) <> c Then
            t = Left(t, i2) + ChrW(8204) + Mid(t, i2 + 1)
            i2 = InStr(i2 + 1, t, c)
        Else
            i2 = i2 + 1
        End If
        Wend
    Next
 
    'borrar todos los caracteres de separación de u
    i2 = InStr(u, ChrW(8204))
    While i2 > 0
        u = Left(u, i2 - 1) + Mid(u, i2 + 1)
        i2 = InStr(u, ChrW(8204))
    Wend
 
    Debug.Print u
    '&2039, &203A: comilla angular simple.
    If Left(t, 1) <> ChrW(&H2039) Then t = ChrW(&H2039) & t
    If Right(t, 1) <> ChrW(&H203A) Then t = t & ChrW(&H203A)
    'Evita separación al final
    If Right(t, 2) = ChrW(8204) + ChrW(&H203A) Then t = Left$(t, Len(t) - 2) & ChrW(&H203A)
    h.TextToDisplay = t
    h.Address = u
 
    Debug.Print t
Next
End Sub