How do I open a specific hyperlink for editing? [closed]

asked 2016-06-10 13:47:53 +0100

this post is marked as community wiki

This post is a wiki. Anyone with karma >75 is welcome to improve it.

I am going through the document looking for broken internal links. When I find one, I want to open it for manual editing, and stop.

I have the text portion with the broken internal link in the variable thisPara. I need to select it, so that .uno:EditHyperlink will open it.

Here’s my code so far (needs the auxilliary function BuildAnchorList which can be found here)

Function isInArray( theString as String, theArray() as String)
    Dim i, iStart, iStop
    iStart = LBound(theArray)
    iStop = UBound(theArray)
    If iStart<=iStop then
        For i = iStart to iStop
            If theString = theArray(i) then
                isInArray = True
                Exit function
            End if
    End if
    isInArray = False
End function

Sub FindBrokenInternalLinks
    ' Find the next broken internal link
    ' Pseudocode:
    ' * generate link of anchors - *** TO DO: prefix the outline numbering for headings
    ' * loop, searching for internal links
    '     - is the internal link in the anchor list?
    '         * Yes: continue to next link
    '         * No: (broken link found)
    '             - select that link text - *** TO DO: cannot select it
    '             - open link editor so user can fix this
    '             - stop
    ' * end loop
    ' * display message "No bad internal links found"

    Dim oDoc as Object, oFrame as Object, oDispatcher as Object
    Dim oAnchors() as String ' list of all anchors in the document
    Dim oParagraphs, thisPara, oTextPortions, thisPortion ' for interating through doc
    Dim sMsg ' for MsgBox

    oDoc = ThisComponent
    oFrame = ThisComponent.CurrentController.Frame
    oDispatcher = createUnoService("")

    ' get all document anchors
    oAnchors = BuildAnchorList()
    PrintArray("Anchor list", oAnchors) ' *** DEBUG ***

    ' find links    
    oParagraphs = oDoc.Text.createEnumeration ' has all the paragraphs
    Dim iLinks
    Dim oViewCursor
    Dim sLink
    iLinks = 0 ' internal link counter

    ' go through all the paragraphs
    While oParagraphs.hasMoreElements
        thisPara = oParagraphs.nextElement
        oTextPortions = thisPara.createEnumeration
        ' go through all the text portions in current paragraph
        While oTextPortions.hasMoreElements
            thisPortion = oTextPortions.nextElement
            If left(thisPortion.HyperLinkURL, 1) = "#" then
                ' internal link found
                iLinks = iLinks + 1
                sLink = thisPortion.HyperLinkURL
                If not isInArray(sLink, oAnchors) then
                    ' anchor not found
                    ' *** DEBUG: code below up to MsgBox
                    Dim sHas
                    If HasUnoInterfaces(thisPortion, "") then _
                        sHas = "yes" Else sHas = "no"
                    sMsg = "Bad link: [" & thisPortion.String & "] -> [" _
                        & thisPortion.HyperLinkURL & "] XTextRange interface? " & sHas
                    MsgBox (sMsg, 48, "Find broken internal link")
                    ' ***
                    ' *** TO DO: How do we open a _specific_ hyperlink for editing?
                    ' Do we pass parameters to `.uno:EditHyperlink`?
                    ' Do we move the cursor? (Except all moves I found were relative,
                    ' e.g. `.uno:GoRight`)
                    ' Do we use the text portion’s `.Start` and `.End` properties?
                    ' ***
                    ' open the current hyperlink for editing
                    oDispatcher.executeDispatch(oFrame, ".uno:EditHyperlink", "", 0, Array())
                    Exit sub
                End If
            End if
    If iLinks then
        sMsg = iLinks & " internal links found, all good"
        sMsg = "This document has no internal links"
    End if
    MsgBox (sMsg, 64, "Find broken internal link")
End Sub
edit retag flag offensive reopen merge delete

Closed for the following reason question is not relevant or outdated by Alex Kemp
close date 2020-09-06 22:46:51.433885