1

I have a column with many URLs, some of them are not clickable (as blue), I need to select one by one, then ctrl+x, ctrl+v, then enter to transform URLs as text to HTTP links.

It's very annoying, I have tons of URLs, I'm pretty sure something exists to render all as clickable links.

Any idea ?

1 Answers1

-1

Here's a Basic macro for LibreOffice Calc to make clickable links of URL strings in a selected 1-column sheet cell range. It skips any blank, numeric, or datetime cells but assumes text cells each contain a valid URL. To avoid accidental activation aborts with a message box if more than one column selected or a blank cell in first row. No harm done if run twice. Ctrl-Z to undo effects 1 cell at a time.

If copied to a module under My Macros (Tools | Macros | Organise …) it should be available to all Calc sheets.

Credits go to Andrew Pitonyak from whose OOo Macro document the essentials were snipped.

Sub ActivateUrlsAsLinks
    Const boxtitle = "URL activator"
    Dim msg As String
    Dim oSels As Object, cell As Object
    oSels = ThisComponent.getCurrentController().getSelection()
    cell = oSels.getCellByPosition(0, 0)
If oSels.Columns.getCount <> 1 Or cell.getString() = "" Then
    msg = "Select cell range with URLs to be converted to clickable links, " & _
          "then run this macro." & _
          Chr(10) &  Chr(10) & "NB: 1 column, and a URL in first row."
    MsgBox msg, MB_ICONSTOP, boxtitle
Else
    Dim txtfld As Object, celltxt As Object
    Dim rix As Integer, subs As Integer, cstr as String
    subs = 0
    For rix = 0 To oSels.Rows.getCount - 1
        cell = oSels.getCellByPosition(0, rix)
        cstr = cell.getString()
        If Len(Trim(cstr)) > 0 And Not IsNumeric(cstr) And Not IsDate(cstr) Then
            txtfld = ThisComponent.createInstance("com.sun.star.text.TextField.URL")
            txtfld.Representation = cstr
            txtfld.URL = ConvertToURL(cstr)
            cell.setString("")
            celltxt = cell.getText()
            celltxt.insertTextContent(celltxt.createTextCursor(), txtfld, False)
            subs = subs + 1
        End If
    Next rix
    msg = "Replaced " & subs & " cells"
    MsgBox msg, MB_ICONINFORMATION, boxtitle
End If

End Sub

urznow
  • 109