我如何检查 Star Basic 中损坏的内部链接？
How do I check for broken internal links in Star Basic?
我正在为 LibreOffice Writer 创建一个 Basic 宏来检查损坏的内部 links。简而言之：
- 生成所有锚点的列表
- 遍历文档，找到内部 hyperlinks
- 如果内部 hyperlink 不在锚列表中，打开它进行编辑（并停止）
我的代码有几个未解决的问题：
- （在
fnBuildAnchorList 内）我们如何获得每个标题的编号？例如，如果第一个 1 级标题文本是“简介”，则正确的锚点是 #1.Introduction|outline，我们正在记录 Introduction|outline
- （在
subInspectLink 内）我们如何正确测试 hyperlink 到标题？我注意到当我手动跟随 link 到标题时，当编号相同时它会成功， 但当文本相同时也会 。
例如如果有一个内部 link #1.My first heading|outline，它可以通过 hyperlink #1.Previous header name|outline 达到，但也可以通过 hyper[=54 达到=] #2.3.5.My first heading|outline
- （在
subInspectLink内）我们如何打开一个specific hyperlink进行编辑？我们是否将参数传递给 .uno:EditHyperlink？我们移动光标吗？ （我发现的所有移动都是相对的，例如 .uno:GoRight）我们是否使用文本部分的 .Start 和 .End 属性？
REM ***** BASIC *****
Option Explicit
' PrintArray displays a MsgBox with the whole array
' for DEBUG purposes only
Sub subPrintArray(sTitle as String, theArray() as String)
Dim sArray
sArray = sTitle & ":" & Chr(13) & Join(theArray,Chr(13))
MsgBox(sArray, 64, "***DEBUG")
End sub
' auxiliary sub for BuildAnchorList
Sub subAddItemToAnchorList (oAnchors() as String, sTheAnchor as String, sType as String)
Dim sAnchor
Select Case sType
Case "Heading":
sAnchor = sTheAnchor + "|outline"
Case "Table":
sAnchor = sTheAnchor + "|table"
Case "Text Frame":
sAnchor = sTheAnchor + "|frame"
Case "Image":
sAnchor = sTheAnchor + "|graphic"
Case "Object":
sAnchor = sTheAnchor + "|ole"
Case "Section":
sAnchor = sTheAnchor + "|region"
Case "Bookmark":
sAnchor = sTheAnchor
End Select
ReDim Preserve oAnchors(UBound(oAnchors)+1) as String
oAnchors(UBound(oAnchors)) = sAnchor
End Sub
' auxiliary sub for BuildAnchorList
Sub subAddArrayToAnchorList (oAnchors() as String, oNewAnchors() as String, sType as String)
Dim i, iStart, iStop
iStart = LBound(oNewAnchors)
iStop = UBound(oNewAnchors)
If iStop < iStart then Exit Sub ' empty array, nothing to do
For i = iStart to iStop
subAddItemToAnchorList (oAnchors, oNewAnchors(i), sType)
Next
End Sub
Function fnBuildAnchorList()
Dim oDoc as Object, oAnchors() as String
oDoc = ThisComponent
' get the whole document outline
Dim oParagraphs, thisPara, oTextPortions, thisPortion
oParagraphs = oDoc.Text.createEnumeration ' all the paragraphs
Do While oParagraphs.hasMoreElements
thisPara = oParagraphs.nextElement
If thisPara.ImplementationName = "SwXParagraph" then ' is a paragraph
If thisPara.OutlineLevel>0 Then ' is a heading
' ***
' *** TO DO: How do we get the numbering for each heading?
' For example, if the first level 1 heading text is “Introduction”,
' the correct anchor is `#1.Introduction|outline`
' and we are recording `Introduction|outline`
' ***
subAddItemToAnchorList (oAnchors, thisPara.String, "Heading")
End if
End if
Loop
' text tables, text frames, images, objects, bookmarks and text sections
subAddArrayToAnchorList(oAnchors, oDoc.getTextTables().ElementNames, "Table")
subAddArrayToAnchorList(oAnchors, oDoc.getTextFrames().ElementNames, "Text Frame")
subAddArrayToAnchorList(oAnchors, oDoc.getGraphicObjects().ElementNames, "Image")
subAddArrayToAnchorList(oAnchors, oDoc.getEmbeddedObjects().ElementNames, "Object")
subAddArrayToAnchorList(oAnchors, oDoc.Bookmarks.ElementNames, "Bookmark")
subAddArrayToAnchorList(oAnchors, oDoc.getTextSections().ElementNames, "Section")
fnBuildAnchorList = oAnchors
End Function
Function fnIsInArray( theString as String, theArray() as String )
Dim i as Integer, iStart as Integer, iStop as Integer
iStart = LBound(theArray)
iStop = UBound(theArray)
If iStart<=iStop then
For i = iStart to iStop
If theString = theArray(i) then
fnIsInArray = True
Exit function
End if
Next
End if
fnIsInArray = False
End function
Function fnIsOutlineInArray ( theString as String, theArray() as String )
Dim i as Integer
For i = LBound(theArray) to UBound(theArray)
If theArray(i) = Right(theString,Len(theArray(i))) then
fnIsOutlineInArray = True
Exit function
End if
Next
fnIsOutlineInArray = False
End function
' auxiliary function to FindBrokenInternalLinks
' inspects any links inside the current document fragment
' used to have an enumeration inside an enumeration, per OOo examples,
' but tables don't have .createEnumeration
Sub subInspectLinks( oAnchors as Object, oFragment as Object, iFragments as Integer, iLinks as Integer )
Dim sMsg, sImplementation, thisPortion
sImplementation = oFragment.implementationName
Select Case sImplementation
Case "SwXParagraph":
' paragraphs can be enumerated
Dim oParaPortions, sLink, notFound
oParaPortions = oFragment.createEnumeration
' go through all the text portions in current paragraph
While oParaPortions.hasMoreElements
thisPortion = oParaPortions.nextElement
iFragments = iFragments + 1
If Left(thisPortion.HyperLinkURL, 1) = "#" then
' internal link found: get it all except initial # character
iLinks = iLinks + 1
sLink = right(thisPortion.HyperLinkURL, Len(thisPortion.HyperLinkURL)-1)
If Left(sLink,14) = "__RefHeading__" then
' link inside a table of contents, no need to check
notFound = False
Elseif Right(sLink,8) = "|outline" then
' special case for outline: since we don't know how to get the
' outline numbering, we have to match the right most part of the
' link only
notFound = not fnIsOutlineInArray(sLink, oAnchors)
Else
notFound = not fnIsInArray(sLink, oAnchors)
End if
If notFound then
' anchor not found
' *** DEBUG: code below up to MsgBox
sMsg = "Fragment #" & iFragments & ", internal link #" & iLinks & Chr(13) _
& "Bad link: [" & thisPortion.String & "] -> [" _
& thisPortion.HyperLinkURL & "] " & Chr(13) _
& "Paragraph:" & Chr(13) & oFragment.String & Chr(13) _
& "OK to continue, Cancel to stop"
Dim iChoice as Integer
iChoice = MsgBox (sMsg, 48+1, "Find broken internal link")
If iChoice = 2 Then End
' ***
' *** 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?
' ***
End If
End if
Wend
' *** END paragraph
Case "SwXTextTable":
' text tables have cells
Dim i, eCells, thisCell, oCellPortions
eCells = oFragment.getCellNames()
For i = LBound(eCells) to UBound(eCells)
thisCell = oFragment.getCellByName(eCells(i))
oCellPortions = thisCell.createEnumeration
While oCellPortions.hasMoreElements
thisPortion = oCellPortions.nextElement
iFragments = iFragments + 1
' a table cell may contain a paragraph or another table,
' so call recursively
subInspectLinks (oAnchors, thisPortion, iFragments, iLinks)
Wend
' xray thisPortion
'SwXCell has .String
Next
' *** END text table
Case Else
sMsg = "Implementation method '" & sImplementation & "' not covered by regular code." _
& "OK to continue, Cancel to stop"
If 2 = MsgBox(sMsg, 48+1) then End
' uses xray for element inspection; if not available, comment the two following lines
BasicLibraries.loadLibrary("XrayTool")
xray oFragment
' *** END unknown case
End Select
End sub
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, oFragments as Object, thisFragment as Object
Dim iFragments as Integer, iLinks as Integer, sMsg as String
Dim oAnchors() as String ' list of all anchors in the document
' Dim sMsg ' for MsgBox
oDoc = ThisComponent
' get all document anchors
oAnchors = fnBuildAnchorList()
' subPrintArray("Anchor list", oAnchors) ' *** DEBUG ***
' MsgBox( UBound(oAnchors)-LBound(oAnchors)+1 & " anchors found – stand by for checking")
' find links
iFragments = 0 ' fragment counter
iLinks = 0 ' internal link counter
oFragments = oDoc.Text.createEnumeration ' has all the paragraphs
While oFragments.hasMoreElements
thisFragment = oFragments.nextElement
iFragments = iFragments + 1
subInspectLinks (oAnchors, thisFragment, iFragments, iLinks)
Wend
If iLinks then
sMsg = iLinks & " internal links found, all good"
Else
sMsg = "This document has no internal links"
End if
MsgBox (sMsg, 64, "Find broken internal link")
End Sub
' *** END FindBrokenInternalLinks ***
您可以使用任何带标题的文档来检查第一期 - 将弹出一个包含所有锚点的 MsgBox，您会看到缺少的大纲编号。
第二期需要一个内部错误的文档link。
查看 cOOol。你可以使用这个
而不是创建宏，
或者从代码中借用一些概念。
测试链接（可能使用 .uno:JumpToMark）似乎没有帮助，
因为内部链接总是某个地方，即使目标不存在。
相反，按照您的建议构建有效目标列表。
为了保存有效目标列表，cOOol 代码使用了 Python 集合。
如果要使用 Basic，则数据结构会受到更多限制。
然而，它可以通过声明一个新的 a
Collection 对象
或者通过使用基本数组，也许 ReDim.
另请查看漂亮的代码如何定义有效的目标字符串。例如：
internal_targets.add('0.' * heading_level + data + '|outline')
要打开超链接对话框，select 超链接文本然后调用：
dispatcher.executeDispatch(document, ".uno:EditHyperlink", "", 0, Array())
编辑:
好的，我为此工作了几个小时，得出了以下代码：
REM ***** BASIC *****
Option Explicit
' PrintArray displays a MsgBox with the whole array
' for DEBUG purposes only
Sub subPrintArray(sTitle as String, theArray() as String)
Dim sArray
sArray = sTitle & ":" & Chr(13) & Join(theArray,Chr(13))
MsgBox(sArray, 64, "***DEBUG")
End sub
' auxiliary sub for BuildAnchorList
Sub subAddItemToAnchorList (oAnchors() as String, sTheAnchor as String, sType as String)
Dim sAnchor
Select Case sType
Case "Heading":
sAnchor = sTheAnchor + "|outline"
Case "Table":
sAnchor = sTheAnchor + "|table"
Case "Text Frame":
sAnchor = sTheAnchor + "|frame"
Case "Image":
sAnchor = sTheAnchor + "|graphic"
Case "Object":
sAnchor = sTheAnchor + "|ole"
Case "Section":
sAnchor = sTheAnchor + "|region"
Case "Bookmark":
sAnchor = sTheAnchor
End Select
ReDim Preserve oAnchors(UBound(oAnchors)+1) as String
oAnchors(UBound(oAnchors)) = sAnchor
End Sub
' auxiliary sub for BuildAnchorList
Sub subAddArrayToAnchorList (oAnchors() as String, oNewAnchors() as String, sType as String)
Dim i, iStart, iStop
iStart = LBound(oNewAnchors)
iStop = UBound(oNewAnchors)
If iStop < iStart then Exit Sub ' empty array, nothing to do
For i = iStart to iStop
subAddItemToAnchorList (oAnchors, oNewAnchors(i), sType)
Next
End Sub
' Updates outlineLevels for the current level.
' Returns a string like "1.2.3"
Function fnGetOutlinePrefix(outlineLevel as Integer, outlineLevels() as Integer)
Dim level as Integer, prefix as String
outlineLevels(outlineLevel) = outlineLevels(outlineLevel) + 1
For level = outlineLevel + 1 to 9
' Reset all lower levels.
outlineLevels(level) = 0
Next
prefix = ""
For level = 0 To outlineLevel
prefix = prefix & outlineLevels(level) & "."
Next
fnGetOutlinePrefix = prefix
End Function
Function fnBuildAnchorList()
Dim oDoc as Object, oAnchors() as String, anchorName as String
Dim level as Integer, levelCounter as Integer
Dim outlineLevels(10) as Integer
For level = 0 to 9
outlineLevels(level) = 0
Next
oDoc = ThisComponent
' get the whole document outline
Dim oParagraphs, thisPara, oTextPortions, thisPortion
oParagraphs = oDoc.Text.createEnumeration ' all the paragraphs
Do While oParagraphs.hasMoreElements
thisPara = oParagraphs.nextElement
If thisPara.ImplementationName = "SwXParagraph" then ' is a paragraph
If thisPara.OutlineLevel>0 Then ' is a heading
level = thisPara.OutlineLevel - 1
anchorName = fnGetOutlinePrefix(level, outlineLevels) & thisPara.String
subAddItemToAnchorList (oAnchors, anchorName, "Heading")
End if
End if
Loop
' text tables, text frames, images, objects, bookmarks and text sections
subAddArrayToAnchorList(oAnchors, oDoc.getTextTables().ElementNames, "Table")
subAddArrayToAnchorList(oAnchors, oDoc.getTextFrames().ElementNames, "Text Frame")
subAddArrayToAnchorList(oAnchors, oDoc.getGraphicObjects().ElementNames, "Image")
subAddArrayToAnchorList(oAnchors, oDoc.getEmbeddedObjects().ElementNames, "Object")
subAddArrayToAnchorList(oAnchors, oDoc.Bookmarks.ElementNames, "Bookmark")
subAddArrayToAnchorList(oAnchors, oDoc.getTextSections().ElementNames, "Section")
fnBuildAnchorList = oAnchors
End Function
Function fnIsInArray( theString as String, theArray() as String )
Dim i as Integer
For i = LBound(theArray()) To UBound(theArray())
If theString = theArray(i) Then
fnIsInArray = True
Exit function
End if
Next
fnIsInArray = False
End function
' Open a _specific_ hyperlink for editing.
Sub subEditHyperlink(textRange as Object)
Dim document As Object
Dim dispatcher As Object
Dim oVC As Object
oVC = ThisComponent.getCurrentController().getViewCursor()
oVC.gotoRange(textRange.getStart(), False)
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dispatcher.executeDispatch(document, ".uno:EditHyperlink", "", 0, Array())
End Sub
' auxiliary function to FindBrokenInternalLinks
' inspects any links inside the current document fragment
' used to have an enumeration inside an enumeration, per OOo examples,
' but tables don't have .createEnumeration
Sub subInspectLinks(oAnchors() as String, oFragment as Object, iFragments as Integer, iLinks as Integer, iBadLinks as Integer)
Dim sMsg, sImplementation, thisPortion
sImplementation = oFragment.implementationName
Select Case sImplementation
Case "SwXParagraph":
' paragraphs can be enumerated
Dim oParaPortions, sLink, notFound
oParaPortions = oFragment.createEnumeration
' go through all the text portions in current paragraph
While oParaPortions.hasMoreElements
thisPortion = oParaPortions.nextElement
iFragments = iFragments + 1
If Left(thisPortion.HyperLinkURL, 1) = "#" then
' internal link found: get it all except initial # character
iLinks = iLinks + 1
sLink = right(thisPortion.HyperLinkURL, Len(thisPortion.HyperLinkURL)-1)
If Left(sLink,14) = "__RefHeading__" then
' link inside a table of contents, no need to check
notFound = False
Else
notFound = not fnIsInArray(sLink, oAnchors)
End if
If notFound then
' anchor not found
' *** DEBUG: code below up to MsgBox
iBadLinks = iBadLinks + 1
sMsg = "Fragment #" & iFragments & ", internal link #" & iLinks & Chr(13) _
& "Bad link: [" & thisPortion.String & "] -> [" _
& thisPortion.HyperLinkURL & "] " & Chr(13) _
& "Paragraph:" & Chr(13) & oFragment.String & Chr(13) _
& "Yes to edit link, No to continue, Cancel to stop"
Dim iChoice as Integer
iChoice = MsgBox (sMsg, MB_YESNOCANCEL + MB_ICONEXCLAMATION, _
"Find broken internal link")
If iChoice = IDCANCEL Then
End
ElseIf iChoice = IDYES Then
subEditHyperlink(thisPortion)
End If
End If
End if
Wend
' *** END paragraph
Case "SwXTextTable":
' text tables have cells
Dim i, eCells, thisCell, oCellPortions
eCells = oFragment.getCellNames()
For i = LBound(eCells) to UBound(eCells)
thisCell = oFragment.getCellByName(eCells(i))
oCellPortions = thisCell.createEnumeration
While oCellPortions.hasMoreElements
thisPortion = oCellPortions.nextElement
iFragments = iFragments + 1
' a table cell may contain a paragraph or another table,
' so call recursively
subInspectLinks (oAnchors, thisPortion, iFragments, iLinks)
Wend
' xray thisPortion
'SwXCell has .String
Next
' *** END text table
Case Else
sMsg = "Implementation method '" & sImplementation & "' not covered by regular code." _
& "OK to continue, Cancel to stop"
If 2 = MsgBox(sMsg, 48+1) then End
' uses xray for element inspection; if not available, comment the two following lines
BasicLibraries.loadLibrary("XrayTool")
xray oFragment
' *** END unknown case
End Select
End sub
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, oFragments as Object, thisFragment as Object
Dim iFragments as Integer, iLinks as Integer, iBadLinks as Integer, sMsg as String
Dim oAnchors() as String ' list of all anchors in the document
oDoc = ThisComponent
' get all document anchors
oAnchors = fnBuildAnchorList()
' subPrintArray("Anchor list", oAnchors) ' *** DEBUG ***
' MsgBox( UBound(oAnchors)-LBound(oAnchors)+1 & " anchors found – stand by for checking")
' find links
iFragments = 0 ' fragment counter
iLinks = 0 ' internal link counter
iBadLinks = 0
oFragments = oDoc.Text.createEnumeration ' has all the paragraphs
While oFragments.hasMoreElements
thisFragment = oFragments.nextElement
iFragments = iFragments + 1
subInspectLinks (oAnchors, thisFragment, iFragments, iLinks, iBadLinks)
Wend
If iBadLinks > 0 Then
sMsg = iBadLinks & " bad link(s), " & iLinks - iBadLinks & " good link(s)"
ElseIf iLinks Then
sMsg = iLinks & " internal link(s) found, all good"
Else
sMsg = "This document has no internal links"
End if
MsgBox (sMsg, 64, "Find broken internal link")
End Sub
' *** END FindBrokenInternalLinks ***
它现在检查大纲编号。也许它太严格了——也许有一个选项可以关闭大纲数字检查会很好。
就问题 3 而言，此代码现在可以打开正确的编辑链接（只要在消息框中单击 "Yes"）。
我正在为 LibreOffice Writer 创建一个 Basic 宏来检查损坏的内部 links。简而言之：
- 生成所有锚点的列表
- 遍历文档，找到内部 hyperlinks
- 如果内部 hyperlink 不在锚列表中，打开它进行编辑（并停止）
我的代码有几个未解决的问题：
- （在
fnBuildAnchorList内）我们如何获得每个标题的编号？例如，如果第一个 1 级标题文本是“简介”，则正确的锚点是#1.Introduction|outline，我们正在记录Introduction|outline - （在
subInspectLink内）我们如何正确测试 hyperlink 到标题？我注意到当我手动跟随 link 到标题时，当编号相同时它会成功， 但当文本相同时也会 。
例如如果有一个内部 link#1.My first heading|outline，它可以通过 hyperlink#1.Previous header name|outline达到，但也可以通过 hyper[=54 达到=]#2.3.5.My first heading|outline - （在
subInspectLink内）我们如何打开一个specific hyperlink进行编辑？我们是否将参数传递给.uno:EditHyperlink？我们移动光标吗？ （我发现的所有移动都是相对的，例如.uno:GoRight）我们是否使用文本部分的.Start和.End属性？
REM ***** BASIC *****
Option Explicit
' PrintArray displays a MsgBox with the whole array
' for DEBUG purposes only
Sub subPrintArray(sTitle as String, theArray() as String)
Dim sArray
sArray = sTitle & ":" & Chr(13) & Join(theArray,Chr(13))
MsgBox(sArray, 64, "***DEBUG")
End sub
' auxiliary sub for BuildAnchorList
Sub subAddItemToAnchorList (oAnchors() as String, sTheAnchor as String, sType as String)
Dim sAnchor
Select Case sType
Case "Heading":
sAnchor = sTheAnchor + "|outline"
Case "Table":
sAnchor = sTheAnchor + "|table"
Case "Text Frame":
sAnchor = sTheAnchor + "|frame"
Case "Image":
sAnchor = sTheAnchor + "|graphic"
Case "Object":
sAnchor = sTheAnchor + "|ole"
Case "Section":
sAnchor = sTheAnchor + "|region"
Case "Bookmark":
sAnchor = sTheAnchor
End Select
ReDim Preserve oAnchors(UBound(oAnchors)+1) as String
oAnchors(UBound(oAnchors)) = sAnchor
End Sub
' auxiliary sub for BuildAnchorList
Sub subAddArrayToAnchorList (oAnchors() as String, oNewAnchors() as String, sType as String)
Dim i, iStart, iStop
iStart = LBound(oNewAnchors)
iStop = UBound(oNewAnchors)
If iStop < iStart then Exit Sub ' empty array, nothing to do
For i = iStart to iStop
subAddItemToAnchorList (oAnchors, oNewAnchors(i), sType)
Next
End Sub
Function fnBuildAnchorList()
Dim oDoc as Object, oAnchors() as String
oDoc = ThisComponent
' get the whole document outline
Dim oParagraphs, thisPara, oTextPortions, thisPortion
oParagraphs = oDoc.Text.createEnumeration ' all the paragraphs
Do While oParagraphs.hasMoreElements
thisPara = oParagraphs.nextElement
If thisPara.ImplementationName = "SwXParagraph" then ' is a paragraph
If thisPara.OutlineLevel>0 Then ' is a heading
' ***
' *** TO DO: How do we get the numbering for each heading?
' For example, if the first level 1 heading text is “Introduction”,
' the correct anchor is `#1.Introduction|outline`
' and we are recording `Introduction|outline`
' ***
subAddItemToAnchorList (oAnchors, thisPara.String, "Heading")
End if
End if
Loop
' text tables, text frames, images, objects, bookmarks and text sections
subAddArrayToAnchorList(oAnchors, oDoc.getTextTables().ElementNames, "Table")
subAddArrayToAnchorList(oAnchors, oDoc.getTextFrames().ElementNames, "Text Frame")
subAddArrayToAnchorList(oAnchors, oDoc.getGraphicObjects().ElementNames, "Image")
subAddArrayToAnchorList(oAnchors, oDoc.getEmbeddedObjects().ElementNames, "Object")
subAddArrayToAnchorList(oAnchors, oDoc.Bookmarks.ElementNames, "Bookmark")
subAddArrayToAnchorList(oAnchors, oDoc.getTextSections().ElementNames, "Section")
fnBuildAnchorList = oAnchors
End Function
Function fnIsInArray( theString as String, theArray() as String )
Dim i as Integer, iStart as Integer, iStop as Integer
iStart = LBound(theArray)
iStop = UBound(theArray)
If iStart<=iStop then
For i = iStart to iStop
If theString = theArray(i) then
fnIsInArray = True
Exit function
End if
Next
End if
fnIsInArray = False
End function
Function fnIsOutlineInArray ( theString as String, theArray() as String )
Dim i as Integer
For i = LBound(theArray) to UBound(theArray)
If theArray(i) = Right(theString,Len(theArray(i))) then
fnIsOutlineInArray = True
Exit function
End if
Next
fnIsOutlineInArray = False
End function
' auxiliary function to FindBrokenInternalLinks
' inspects any links inside the current document fragment
' used to have an enumeration inside an enumeration, per OOo examples,
' but tables don't have .createEnumeration
Sub subInspectLinks( oAnchors as Object, oFragment as Object, iFragments as Integer, iLinks as Integer )
Dim sMsg, sImplementation, thisPortion
sImplementation = oFragment.implementationName
Select Case sImplementation
Case "SwXParagraph":
' paragraphs can be enumerated
Dim oParaPortions, sLink, notFound
oParaPortions = oFragment.createEnumeration
' go through all the text portions in current paragraph
While oParaPortions.hasMoreElements
thisPortion = oParaPortions.nextElement
iFragments = iFragments + 1
If Left(thisPortion.HyperLinkURL, 1) = "#" then
' internal link found: get it all except initial # character
iLinks = iLinks + 1
sLink = right(thisPortion.HyperLinkURL, Len(thisPortion.HyperLinkURL)-1)
If Left(sLink,14) = "__RefHeading__" then
' link inside a table of contents, no need to check
notFound = False
Elseif Right(sLink,8) = "|outline" then
' special case for outline: since we don't know how to get the
' outline numbering, we have to match the right most part of the
' link only
notFound = not fnIsOutlineInArray(sLink, oAnchors)
Else
notFound = not fnIsInArray(sLink, oAnchors)
End if
If notFound then
' anchor not found
' *** DEBUG: code below up to MsgBox
sMsg = "Fragment #" & iFragments & ", internal link #" & iLinks & Chr(13) _
& "Bad link: [" & thisPortion.String & "] -> [" _
& thisPortion.HyperLinkURL & "] " & Chr(13) _
& "Paragraph:" & Chr(13) & oFragment.String & Chr(13) _
& "OK to continue, Cancel to stop"
Dim iChoice as Integer
iChoice = MsgBox (sMsg, 48+1, "Find broken internal link")
If iChoice = 2 Then End
' ***
' *** 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?
' ***
End If
End if
Wend
' *** END paragraph
Case "SwXTextTable":
' text tables have cells
Dim i, eCells, thisCell, oCellPortions
eCells = oFragment.getCellNames()
For i = LBound(eCells) to UBound(eCells)
thisCell = oFragment.getCellByName(eCells(i))
oCellPortions = thisCell.createEnumeration
While oCellPortions.hasMoreElements
thisPortion = oCellPortions.nextElement
iFragments = iFragments + 1
' a table cell may contain a paragraph or another table,
' so call recursively
subInspectLinks (oAnchors, thisPortion, iFragments, iLinks)
Wend
' xray thisPortion
'SwXCell has .String
Next
' *** END text table
Case Else
sMsg = "Implementation method '" & sImplementation & "' not covered by regular code." _
& "OK to continue, Cancel to stop"
If 2 = MsgBox(sMsg, 48+1) then End
' uses xray for element inspection; if not available, comment the two following lines
BasicLibraries.loadLibrary("XrayTool")
xray oFragment
' *** END unknown case
End Select
End sub
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, oFragments as Object, thisFragment as Object
Dim iFragments as Integer, iLinks as Integer, sMsg as String
Dim oAnchors() as String ' list of all anchors in the document
' Dim sMsg ' for MsgBox
oDoc = ThisComponent
' get all document anchors
oAnchors = fnBuildAnchorList()
' subPrintArray("Anchor list", oAnchors) ' *** DEBUG ***
' MsgBox( UBound(oAnchors)-LBound(oAnchors)+1 & " anchors found – stand by for checking")
' find links
iFragments = 0 ' fragment counter
iLinks = 0 ' internal link counter
oFragments = oDoc.Text.createEnumeration ' has all the paragraphs
While oFragments.hasMoreElements
thisFragment = oFragments.nextElement
iFragments = iFragments + 1
subInspectLinks (oAnchors, thisFragment, iFragments, iLinks)
Wend
If iLinks then
sMsg = iLinks & " internal links found, all good"
Else
sMsg = "This document has no internal links"
End if
MsgBox (sMsg, 64, "Find broken internal link")
End Sub
' *** END FindBrokenInternalLinks ***
您可以使用任何带标题的文档来检查第一期 - 将弹出一个包含所有锚点的 MsgBox，您会看到缺少的大纲编号。
第二期需要一个内部错误的文档link。
查看 cOOol。你可以使用这个 而不是创建宏， 或者从代码中借用一些概念。
测试链接（可能使用 .uno:JumpToMark）似乎没有帮助，
因为内部链接总是某个地方，即使目标不存在。
相反，按照您的建议构建有效目标列表。
为了保存有效目标列表，cOOol 代码使用了 Python 集合。
如果要使用 Basic，则数据结构会受到更多限制。
然而，它可以通过声明一个新的 a
Collection 对象
或者通过使用基本数组，也许 ReDim.
另请查看漂亮的代码如何定义有效的目标字符串。例如：
internal_targets.add('0.' * heading_level + data + '|outline')
要打开超链接对话框，select 超链接文本然后调用：
dispatcher.executeDispatch(document, ".uno:EditHyperlink", "", 0, Array())
编辑:
好的，我为此工作了几个小时，得出了以下代码：
REM ***** BASIC *****
Option Explicit
' PrintArray displays a MsgBox with the whole array
' for DEBUG purposes only
Sub subPrintArray(sTitle as String, theArray() as String)
Dim sArray
sArray = sTitle & ":" & Chr(13) & Join(theArray,Chr(13))
MsgBox(sArray, 64, "***DEBUG")
End sub
' auxiliary sub for BuildAnchorList
Sub subAddItemToAnchorList (oAnchors() as String, sTheAnchor as String, sType as String)
Dim sAnchor
Select Case sType
Case "Heading":
sAnchor = sTheAnchor + "|outline"
Case "Table":
sAnchor = sTheAnchor + "|table"
Case "Text Frame":
sAnchor = sTheAnchor + "|frame"
Case "Image":
sAnchor = sTheAnchor + "|graphic"
Case "Object":
sAnchor = sTheAnchor + "|ole"
Case "Section":
sAnchor = sTheAnchor + "|region"
Case "Bookmark":
sAnchor = sTheAnchor
End Select
ReDim Preserve oAnchors(UBound(oAnchors)+1) as String
oAnchors(UBound(oAnchors)) = sAnchor
End Sub
' auxiliary sub for BuildAnchorList
Sub subAddArrayToAnchorList (oAnchors() as String, oNewAnchors() as String, sType as String)
Dim i, iStart, iStop
iStart = LBound(oNewAnchors)
iStop = UBound(oNewAnchors)
If iStop < iStart then Exit Sub ' empty array, nothing to do
For i = iStart to iStop
subAddItemToAnchorList (oAnchors, oNewAnchors(i), sType)
Next
End Sub
' Updates outlineLevels for the current level.
' Returns a string like "1.2.3"
Function fnGetOutlinePrefix(outlineLevel as Integer, outlineLevels() as Integer)
Dim level as Integer, prefix as String
outlineLevels(outlineLevel) = outlineLevels(outlineLevel) + 1
For level = outlineLevel + 1 to 9
' Reset all lower levels.
outlineLevels(level) = 0
Next
prefix = ""
For level = 0 To outlineLevel
prefix = prefix & outlineLevels(level) & "."
Next
fnGetOutlinePrefix = prefix
End Function
Function fnBuildAnchorList()
Dim oDoc as Object, oAnchors() as String, anchorName as String
Dim level as Integer, levelCounter as Integer
Dim outlineLevels(10) as Integer
For level = 0 to 9
outlineLevels(level) = 0
Next
oDoc = ThisComponent
' get the whole document outline
Dim oParagraphs, thisPara, oTextPortions, thisPortion
oParagraphs = oDoc.Text.createEnumeration ' all the paragraphs
Do While oParagraphs.hasMoreElements
thisPara = oParagraphs.nextElement
If thisPara.ImplementationName = "SwXParagraph" then ' is a paragraph
If thisPara.OutlineLevel>0 Then ' is a heading
level = thisPara.OutlineLevel - 1
anchorName = fnGetOutlinePrefix(level, outlineLevels) & thisPara.String
subAddItemToAnchorList (oAnchors, anchorName, "Heading")
End if
End if
Loop
' text tables, text frames, images, objects, bookmarks and text sections
subAddArrayToAnchorList(oAnchors, oDoc.getTextTables().ElementNames, "Table")
subAddArrayToAnchorList(oAnchors, oDoc.getTextFrames().ElementNames, "Text Frame")
subAddArrayToAnchorList(oAnchors, oDoc.getGraphicObjects().ElementNames, "Image")
subAddArrayToAnchorList(oAnchors, oDoc.getEmbeddedObjects().ElementNames, "Object")
subAddArrayToAnchorList(oAnchors, oDoc.Bookmarks.ElementNames, "Bookmark")
subAddArrayToAnchorList(oAnchors, oDoc.getTextSections().ElementNames, "Section")
fnBuildAnchorList = oAnchors
End Function
Function fnIsInArray( theString as String, theArray() as String )
Dim i as Integer
For i = LBound(theArray()) To UBound(theArray())
If theString = theArray(i) Then
fnIsInArray = True
Exit function
End if
Next
fnIsInArray = False
End function
' Open a _specific_ hyperlink for editing.
Sub subEditHyperlink(textRange as Object)
Dim document As Object
Dim dispatcher As Object
Dim oVC As Object
oVC = ThisComponent.getCurrentController().getViewCursor()
oVC.gotoRange(textRange.getStart(), False)
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dispatcher.executeDispatch(document, ".uno:EditHyperlink", "", 0, Array())
End Sub
' auxiliary function to FindBrokenInternalLinks
' inspects any links inside the current document fragment
' used to have an enumeration inside an enumeration, per OOo examples,
' but tables don't have .createEnumeration
Sub subInspectLinks(oAnchors() as String, oFragment as Object, iFragments as Integer, iLinks as Integer, iBadLinks as Integer)
Dim sMsg, sImplementation, thisPortion
sImplementation = oFragment.implementationName
Select Case sImplementation
Case "SwXParagraph":
' paragraphs can be enumerated
Dim oParaPortions, sLink, notFound
oParaPortions = oFragment.createEnumeration
' go through all the text portions in current paragraph
While oParaPortions.hasMoreElements
thisPortion = oParaPortions.nextElement
iFragments = iFragments + 1
If Left(thisPortion.HyperLinkURL, 1) = "#" then
' internal link found: get it all except initial # character
iLinks = iLinks + 1
sLink = right(thisPortion.HyperLinkURL, Len(thisPortion.HyperLinkURL)-1)
If Left(sLink,14) = "__RefHeading__" then
' link inside a table of contents, no need to check
notFound = False
Else
notFound = not fnIsInArray(sLink, oAnchors)
End if
If notFound then
' anchor not found
' *** DEBUG: code below up to MsgBox
iBadLinks = iBadLinks + 1
sMsg = "Fragment #" & iFragments & ", internal link #" & iLinks & Chr(13) _
& "Bad link: [" & thisPortion.String & "] -> [" _
& thisPortion.HyperLinkURL & "] " & Chr(13) _
& "Paragraph:" & Chr(13) & oFragment.String & Chr(13) _
& "Yes to edit link, No to continue, Cancel to stop"
Dim iChoice as Integer
iChoice = MsgBox (sMsg, MB_YESNOCANCEL + MB_ICONEXCLAMATION, _
"Find broken internal link")
If iChoice = IDCANCEL Then
End
ElseIf iChoice = IDYES Then
subEditHyperlink(thisPortion)
End If
End If
End if
Wend
' *** END paragraph
Case "SwXTextTable":
' text tables have cells
Dim i, eCells, thisCell, oCellPortions
eCells = oFragment.getCellNames()
For i = LBound(eCells) to UBound(eCells)
thisCell = oFragment.getCellByName(eCells(i))
oCellPortions = thisCell.createEnumeration
While oCellPortions.hasMoreElements
thisPortion = oCellPortions.nextElement
iFragments = iFragments + 1
' a table cell may contain a paragraph or another table,
' so call recursively
subInspectLinks (oAnchors, thisPortion, iFragments, iLinks)
Wend
' xray thisPortion
'SwXCell has .String
Next
' *** END text table
Case Else
sMsg = "Implementation method '" & sImplementation & "' not covered by regular code." _
& "OK to continue, Cancel to stop"
If 2 = MsgBox(sMsg, 48+1) then End
' uses xray for element inspection; if not available, comment the two following lines
BasicLibraries.loadLibrary("XrayTool")
xray oFragment
' *** END unknown case
End Select
End sub
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, oFragments as Object, thisFragment as Object
Dim iFragments as Integer, iLinks as Integer, iBadLinks as Integer, sMsg as String
Dim oAnchors() as String ' list of all anchors in the document
oDoc = ThisComponent
' get all document anchors
oAnchors = fnBuildAnchorList()
' subPrintArray("Anchor list", oAnchors) ' *** DEBUG ***
' MsgBox( UBound(oAnchors)-LBound(oAnchors)+1 & " anchors found – stand by for checking")
' find links
iFragments = 0 ' fragment counter
iLinks = 0 ' internal link counter
iBadLinks = 0
oFragments = oDoc.Text.createEnumeration ' has all the paragraphs
While oFragments.hasMoreElements
thisFragment = oFragments.nextElement
iFragments = iFragments + 1
subInspectLinks (oAnchors, thisFragment, iFragments, iLinks, iBadLinks)
Wend
If iBadLinks > 0 Then
sMsg = iBadLinks & " bad link(s), " & iLinks - iBadLinks & " good link(s)"
ElseIf iLinks Then
sMsg = iLinks & " internal link(s) found, all good"
Else
sMsg = "This document has no internal links"
End if
MsgBox (sMsg, 64, "Find broken internal link")
End Sub
' *** END FindBrokenInternalLinks ***
它现在检查大纲编号。也许它太严格了——也许有一个选项可以关闭大纲数字检查会很好。
就问题 3 而言，此代码现在可以打开正确的编辑链接（只要在消息框中单击 "Yes"）。