你能打印 writer 拼写检查生成的波浪线吗？
Can you Print the wavy lines generated by Spell check in writer?
根据google组，此宏可用于打印MS office中拼写错误的单词。
https://groups.google.com/g/microsoft.public.word.spelling.grammar/c/OiFYPkLAbeU
libre-office writer中有类似的选项吗？
以下子例程复制了 Google 组中代码的作用。它比 MS 版本更冗长，但在 LibreOffice / OpenOffice 中是可以预料到的。它只检查拼写检查行，而不检查绿色语法检查行，Google 组中的 MS 版本也是如此。
Sub UnderlineMisspelledWords
' From OOME Listing 315 Page 336
GlobalScope.BasicLibraries.loadLibrary( "Tools" )
Dim sLocale As String
sLocale = GetRegistryKeyContent("org.openoffice.Setup/L10N", FALSE).getByName("ooLocale")
' ooLocale appears to return a string that consists of the language and country
' seperated by a dash, e.g. en-GB
Dim nDash As Integer
nDash = InStr(sLocale, "-")
Dim aLocale As New com.sun.star.lang.Locale
aLocale.Language = Left(sLocale, nDash - 1)
aLocale.Country = Right(sLocale, Len(sLocale) -nDash )
Dim oSpeller As Variant
oSpeller = createUnoService("com.sun.star.linguistic2.SpellChecker")
Dim emptyArgs() as new com.sun.star.beans.PropertyValue
Dim oCursor As Object
oCursor = ThisComponent.getText.createTextCursor()
oCursor.gotoStart(False)
oCursor.collapseToStart()
Dim s as String, bTest As Boolean
Do
oCursor.gotoEndOfWord(True)
s = oCursor.getString()
bTest = oSpeller.isValid(s, aLocale, emptyArgs())
If Not bTest Then
With oCursor
.CharUnderlineHasColor = True
.CharUnderlineColor = RGB(255, 0,0)
.CharUnderline = com.sun.star.awt.FontUnderline.WAVE
' Possible alternatives include SMALLWAVE, DOUBLEWAVE and BOLDWAVE
End With
End If
Loop While oCursor.gotoNextWord(False)
End Sub
这会将字体的实际格式更改为带有红色波浪下划线，这将像任何其他格式一样打印出来。如果文档中任何拼写错误的单词已经带有某种下划线，那么它将会丢失。
您可能希望在打印后删除下划线。以下 Sub 仅在其样式与第一个例程添加的行的样式完全匹配的地方删除下划线。
Sub RemoveUnderlining
Dim oCursor As Object
oCursor = ThisComponent.getText.createTextCursor()
oCursor.gotoStart(False)
oCursor.collapseToStart()
Dim s as String, bTest As Boolean
Do
oCursor.gotoEndOfWord(True)
Dim bTest1 As Boolean
bTest1 = False
If oCursor.CharUnderlineHasColor = True Then
bTest1 = True
End If
Dim bTest2 As Boolean
bTest2 = False
If oCursor.CharUnderlineColor = RGB(255, 0,0) Then
bTest2 = True
End If
Dim bTest3 As Boolean
bTest3 = False
If oCursor.CharUnderline = com.sun.star.awt.FontUnderline.WAVE Then
bTest3 = True
End If
If bTest1 And bTest2 And bTest3 Then
With oCursor
.CharUnderlineHasColor = False
.CharUnderline = com.sun.star.awt.FontUnderline.NONE
End With
End If
Loop While oCursor.gotoNextWord(False)
End Sub
这不会恢复任何被红色波浪形下划线替换的原始下划线。删除波浪线以恢复这些波浪线的其他方法是：
按 undo (Ctrl Z)，但您需要为文档中的每个单词执行一次，这可能会有点麻烦。
运行 子程序 UnderlineMisspelledWords 临时复制文档然后打印后丢弃。
希望这就是您要找的。
针对您的上述评论，直接修改上述子例程即可，而不是绘制波浪线。下面的代码打开一个新的 Writer 文档，并将拼写错误的单词列表以及拼写检查器建议的替代词写入其中：
Sub ListMisSpelledWords
' From OOME Listing 315 Page 336
GlobalScope.BasicLibraries.loadLibrary( "Tools" )
Dim sLocale As String
sLocale = GetRegistryKeyContent("org.openoffice.Setup/L10N", FALSE).getByName("ooLocale")
' ooLocale appears to return a string that consists of the language and country
' seperated by a dash, e.g. en-GB
Dim nDash As Integer
nDash = InStr(sLocale, "-")
Dim aLocale As New com.sun.star.lang.Locale
aLocale.Language = Left(sLocale, nDash - 1)
aLocale.Country = Right(sLocale, Len(sLocale) -nDash )
Dim oSource As Object
oSource = ThisComponent
Dim oSourceCursor As Object
oSourceCursor = oSource.getText.createTextCursor()
oSourceCursor.gotoStart(False)
oSourceCursor.collapseToStart()
Dim oDestination As Object
oDestination = StarDesktop.loadComponentFromURL( "private:factory/swriter", "_blank", 0, Array() )
Dim oDestinationText as Object
oDestinationText = oDestination.getText()
Dim oDestinationCursor As Object
oDestinationCursor = oDestinationText.createTextCursor()
Dim oSpeller As Object
oSpeller = createUnoService("com.sun.star.linguistic2.SpellChecker")
Dim oSpellAlternatives As Object, emptyArgs() as new com.sun.star.beans.PropertyValue
Dim sMistake as String, oSpell As Object, sAlternatives() as String, bTest As Boolean, s As String, i as Integer
Do
oSourceCursor.gotoEndOfWord(True)
sMistake = oSourceCursor.getString()
bTest = oSpeller.isValid(sMistake, aLocale, emptyArgs())
If Not bTest Then
oSpell = oSpeller.spell(sMistake, aLocale, emptyArgs())
sAlternatives = oSpell.getAlternatives()
s = ""
for i = LBound(sAlternatives) To Ubound(sAlternatives) - 1
s = s & sAlternatives(i) & ", "
Next i
s = s & sAlternatives(Ubound(sAlternatives))
oDestinationText.insertString(oDestinationCursor, sMistake & ": " & s & Chr(13), False)
End If
Loop While oSourceCursor.gotoNextWord(False)
End Sub
我不知道字典，但是，为了回答您之前的评论，如果您将以下代码粘贴到 Loop While 下方和 End Sub 上方，它将导致文本出现在新的打开的 Writer 文档正在排序，没有重复项。它不是很优雅，但它适用于我试过的文本。
oDestinationCursor.gotoStart(False)
oDestinationCursor.gotoEnd(True)
Dim oSortDescriptor As Object
oSortDescriptor = oDestinationCursor.createSortDescriptor()
oDestinationCursor.sort(oSortDescriptor)
Dim sParagraphToBeChecked As String
Dim sThisWord As String
sThisWord = ""
Dim sPreviousWord As String
sPreviousWord = ""
oDestinationCursor.gotoStart(False)
oDestinationCursor.collapseToStart()
Dim k As Integer
Do
oDestinationCursor.gotoEndOfParagraph(True)
sParagraphToBeChecked = oDestinationCursor.getString()
k = InStr(sParagraphToBeChecked, ":")
If k <> 0 Then
sThisWord = Left(sParagraphToBeChecked, k-1)
End If
If StrComp(sThisWord, sPreviousWord, 0) = 0 Then
oDestinationCursor.setString("")
End If
sPreviousWord = sThisWord
Loop While oDestinationCursor.gotoNextParagraph(False)
Dim oReplaceDescriptor As Object
oReplaceDescriptor = oDestination.createReplaceDescriptor()
oReplaceDescriptor.setPropertyValue("SearchRegularExpression", TRUE)
oReplaceDescriptor.setSearchString("^$")
oReplaceDescriptor.setReplaceString("")
oDestination.replaceAll(oReplaceDescriptor)
我似乎没有发现这一点，因为我对其进行测试的文本只包含正确的或具有多个零备选词的词。我设法通过输入一个由拼写检查器无法建议任何替代字符的随机字符组成的单词来重现错误。如果找不到替代项，则函数 .getAlternatives() returns 大小为 -1 的数组，因此可以通过在使用数组之前测试此条件来避免错误。下面是子例程中第一个 Do 循环的修改版本，添加了这样的条件。如果用它替换现有循环，它应该会消除错误。
Do
oSourceCursor.gotoEndOfWord(True)
sMistake = oSourceCursor.getString()
bTest = oSpeller.isValid(sMistake, aLocale, emptyArgs())
If Not bTest Then
oSpell = oSpeller.spell(sMistake, aLocale, emptyArgs())
sAlternatives = oSpell.getAlternatives()
s = ""
If Ubound(sAlternatives) >= 0 Then
for i = LBound(sAlternatives) To Ubound(sAlternatives) - 1
s = s & sAlternatives(i) & ", "
Next i
s = s & sAlternatives(Ubound(sAlternatives))
End If
oDestinationText.insertString(oDestinationCursor, sMistake & ": " & s & Chr(13), False)
End If
Loop While oSourceCursor.gotoNextWord(False)
在重新阅读整个子例程时，我认为如果将变量 sMistake 重命名为 sWordToBeChecked 之类的内容会提高其可读性，因为该变量包含的字符串并不总是拼写错误。这当然需要在例程中的任何地方进行更改，而不仅仅是在上面的代码片段中。
下面是使用 Jim K 在其回答 中建议的调度程序的修改版本。我把它完整地写出来了，因为变化比仅仅添加或替换一个块更广泛。特别是，有必要在创建空目标文档之前获取视图光标，否则例程将进行拼写检查。
Sub ListMisSpelledWords2
' From OOME Listing 315 Page 336
GlobalScope.BasicLibraries.loadLibrary( "Tools" )
Dim sLocale As String
sLocale = GetRegistryKeyContent("org.openoffice.Setup/L10N", FALSE).getByName("ooLocale")
' ooLocale appears to return a string that consists of the language and country
' seperated by a dash, e.g. en-GB
Dim nDash As Integer
nDash = InStr(sLocale, "-")
Dim aLocale As New com.sun.star.lang.Locale
aLocale.Language = Left(sLocale, nDash - 1)
aLocale.Country = Right(sLocale, Len(sLocale) -nDash )
Dim oSourceDocument As Object
oSourceDocument = ThisComponent
Dim nWordCount as Integer
nWordCount = oSourceDocument.WordCount
Dim oFrame As Object, oViewCursor As Object
With oSourceDocument.getCurrentController
oFrame = .getFrame()
oViewCursor = .getViewCursor()
End With
Dim oDispatcher as Object
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oDispatcher.executeDispatch(oFrame, ".uno:GoToStartOfDoc", "", 0, Array())
Dim oDestinationDocument As Object
oDestinationDocument = StarDesktop.loadComponentFromURL( "private:factory/swriter", "_blank", 0, Array() )
Dim oDestinationText as Object
oDestinationText = oDestinationDocument.getText()
Dim oDestinationCursor As Object
oDestinationCursor = oDestinationText.createTextCursor()
Dim oSpeller As Object
oSpeller = createUnoService("com.sun.star.linguistic2.SpellChecker")
Dim oSpellAlternatives As Object, emptyArgs() as new com.sun.star.beans.PropertyValue
Dim sMistake as String, oSpell As Object, sAlternatives() as String, bTest As Boolean, s As String, i as Integer
For i = 0 To nWordCount - 1
oDispatcher.executeDispatch(oFrame, ".uno:WordRightSel", "", 0, Array())
sWordToBeChecked = RTrim( oViewCursor.String )
bTest = oSpeller.isValid(sWordToBeChecked, aLocale, emptyArgs())
If Not bTest Then
oSpell = oSpeller.spell(sWordToBeChecked, aLocale, emptyArgs())
sAlternatives = oSpell.getAlternatives()
s = ""
If Ubound(sAlternatives) >= 0 Then
for i = LBound(sAlternatives) To Ubound(sAlternatives) - 1
s = s & sAlternatives(i) & ", "
Next i
s = s & sAlternatives(Ubound(sAlternatives))
End If
oDestinationText.insertString(oDestinationCursor, sWordToBeChecked & ": " & s & Chr(13), False)
End If
oDispatcher.executeDispatch(oFrame, ".uno:GoToPrevWord", "", 0, Array())
oDispatcher.executeDispatch(oFrame, ".uno:GoToNextWord", "", 0, Array())
Next i
oDestinationCursor.gotoStart(False)
oDestinationCursor.gotoEnd(True)
' Sort the paragraphs
Dim oSortDescriptor As Object
oSortDescriptor = oDestinationCursor.createSortDescriptor()
oDestinationCursor.sort(oSortDescriptor)
' Remove duplicates
Dim sParagraphToBeChecked As String, sThisWord As String, sPreviousWord As String
sThisWord = ""
sPreviousWord = ""
oDestinationCursor.gotoStart(False)
oDestinationCursor.collapseToStart()
Dim k As Integer
Do
oDestinationCursor.gotoEndOfParagraph(True)
sParagraphToBeChecked = oDestinationCursor.getString()
k = InStr(sParagraphToBeChecked, ":")
If k <> 0 Then
sThisWord = Left(sParagraphToBeChecked, k-1)
End If
If StrComp(sThisWord, sPreviousWord, 0) = 0 Then
oDestinationCursor.setString("")
End If
sPreviousWord = sThisWord
Loop While oDestinationCursor.gotoNextParagraph(False)
' Remove empty paragraphs
Dim oReplaceDescriptor As Object
oReplaceDescriptor = oDestinationDocument.createReplaceDescriptor()
oReplaceDescriptor.setPropertyValue("SearchRegularExpression", TRUE)
oReplaceDescriptor.setSearchString("^$")
oReplaceDescriptor.setReplaceString("")
oDestinationDocument.replaceAll(oReplaceDescriptor)
End Sub
首先，针对您关于该错误的问题，我不是维护者，因此无法修复。但是，由于该错误涉及将文本光标移动到单词的开头和结尾，因此应该可以通过搜索单词之间的 white-space 来绕过它。由于 white-space 字符（我认为）在所有语言中都是相同的，因此从某些字母表中识别某些字符的任何问题都无关紧要。最简单的方法是首先将文档的整个文本读入一个字符串，但 LibreOffice 字符串的最大长度为 2^16 = 65536 个字符，虽然这看起来很多，但对于一个合理的大小的文档。可以通过一次一个段落地浏览文本来避免该限制。根据 Andrew Pitonyak（OOME 第 388 页）的说法：“我发现 gotoNextSentence() 和 gotoNextWord() 不可靠，但段落光标运行良好。”
下面的代码是对之前答案中子程序的又一次修改。这次它从段落中获取一个字符串，并通过找到单词之间的 white-space 将其拆分为单词。然后它像以前一样拼写检查单词。该子例程依赖于它下面列出的一些其他函数。这些允许您指定将哪些字符指定为单词分隔符（即 white-space），以及在单词的开头或结尾发现哪些字符要忽略。这是必要的，例如，引号周围的引号不计为单词的一部分，即使引号内的单词拼写正确，这也会导致它被识别为拼写错误。
我不熟悉非拉丁字母，也没有安装合适的词典，但我粘贴了你问题 中的单词，即 testी、भारत 和 इंडिया，它们都没有修改过在输出文档中。
关于查找同义词的问题，由于每个拼错的单词都有多个建议，而每个建议都有多个同义词，因此输出可能会很快变得非常大且令人困惑。如果您的用户想使用不同的词，最好单独查找它们。
Sub ListMisSpelledWords3
' From OOME Listing 315 Page 336
GlobalScope.BasicLibraries.loadLibrary( "Tools" )
Dim sLocale As String
sLocale = GetRegistryKeyContent("org.openoffice.Setup/L10N", FALSE).getByName("ooLocale")
' ooLocale appears to return a string that consists of the language and country
' seperated by a dash, e.g. en-GB
Dim nDash As Integer
nDash = InStr(sLocale, "-")
Dim aLocale As New com.sun.star.lang.Locale
aLocale.Language = Left( sLocale, nDash - 1)
aLocale.Country = Right( sLocale, Len(sLocale) - nDash )
Dim oSource As Object
oSource = ThisComponent
Dim oSourceCursor As Object
oSourceCursor = oSource.getText.createTextCursor()
oSourceCursor.gotoStart(False)
oSourceCursor.collapseToStart()
Dim oDestination As Object
oDestination = StarDesktop.loadComponentFromURL( "private:factory/swriter", "_blank", 0, Array() )
Dim oDestinationText as Object
oDestinationText = oDestination.getText()
Dim oDestinationCursor As Object
oDestinationCursor = oDestinationText.createTextCursor()
Dim oSpeller As Object
oSpeller = createUnoService("com.sun.star.linguistic2.SpellChecker")
Dim oSpellAlternatives As Object, emptyArgs() as new com.sun.star.beans.PropertyValue
Dim sWordToCheck as String, oSpell As Object, sAlternatives() as String, bTest As Boolean
Dim s As String, i as Integer, j As Integer, sParagraph As String, nWordStart As Integer, nWordEnd As Integer
Dim nChar As Integer
Do
oSourceCursor.gotoEndOfParagraph(True)
sParagraph = oSourceCursor.getString() & " " 'It is necessary to add a space to the end of
'the string otherwise the last word of the paragraph is not recognised.
nWordStart = 1
nWordEnd = 1
For i = 1 to Len(sParagraph)
nChar = ASC(Mid(sParagraph, i, 1))
If IsWordSeparator(nChar) Then '1
If nWordEnd > nWordStart Then '2
sWordToCheck = TrimWord( Mid(sParagraph, nWordStart, nWordEnd - nWordStart) )
bTest = oSpeller.isValid(sWordToCheck, aLocale, emptyArgs())
If Not bTest Then '3
oSpell = oSpeller.spell(sWordToCheck, aLocale, emptyArgs())
sAlternatives = oSpell.getAlternatives()
s = ""
If Ubound(sAlternatives) >= 0 Then '4
for j = LBound(sAlternatives) To Ubound(sAlternatives) - 1
s = s & sAlternatives(j) & ", "
Next j
s = s & sAlternatives(Ubound(sAlternatives))
End If '4
oDestinationText.insertString(oDestinationCursor, sWordToCheck & " : " & s & Chr(13), False)
End If '3
End If '2
nWordEnd = nWordEnd + 1
nWordStart = nWordEnd
Else
nWordEnd = nWordEnd + 1
End If '1
Next i
Loop While oSourceCursor.gotoNextParagraph(False)
oDestinationCursor.gotoStart(False)
oDestinationCursor.gotoEnd(True)
Dim oSortDescriptor As Object
oSortDescriptor = oDestinationCursor.createSortDescriptor()
oDestinationCursor.sort(oSortDescriptor)
Dim sParagraphToBeChecked As String
Dim sThisWord As String
sThisWord = ""
Dim sPreviousWord As String
sPreviousWord = ""
oDestinationCursor.gotoStart(False)
oDestinationCursor.collapseToStart()
Dim k As Integer
Do
oDestinationCursor.gotoEndOfParagraph(True)
sParagraphToBeChecked = oDestinationCursor.getString()
k = InStr(sParagraphToBeChecked, ":")
If k <> 0 Then
sThisWord = Left(sParagraphToBeChecked, k-1)
End If
If StrComp(sThisWord, sPreviousWord, 0) = 0 Then
oDestinationCursor.setString("")
End If
sPreviousWord = sThisWord
Loop While oDestinationCursor.gotoNextParagraph(False)
Dim oReplaceDescriptor As Object
oReplaceDescriptor = oDestination.createReplaceDescriptor()
oReplaceDescriptor.setPropertyValue("SearchRegularExpression", TRUE)
oReplaceDescriptor.setSearchString("^$")
oReplaceDescriptor.setReplaceString("")
oDestination.replaceAll(oReplaceDescriptor)
End Sub
'----------------------------------------------------------------------------
' From OOME Listing 360.
Function IsWordSeparator(iChar As Integer) As Boolean
' Horizontal tab \t 9
' New line \n 10
' Carriage return \r 13
' Space 32
' Non-breaking space 160
Select Case iChar
Case 9, 10, 13, 32, 160
IsWordSeparator = True
Case Else
IsWordSeparator = False
End Select
End Function
'-------------------------------------
' Characters to be trimmed off beginning of word before spell checking
Function IsPermissiblePrefix(iChar As Integer) As Boolean
' Symmetric double quote " 34
' Left parenthesis ( 40
' Left square bracket [ 91
' Back-tick ` 96
' Left curly bracket { 123
' Left double angle quotation marks « 171
' Left single quotation mark ‘ 8216
' Left single reversed 9 quotation mark ‛ 8219
' Left double quotation mark “ 8220
' Left double reversed 9 quotation mark ‟ 8223
Select Case iChar
Case 34, 40, 91, 96, 123, 171, 8216, 8219, 8220, 8223
IsPermissiblePrefix = True
Case Else
IsPermissiblePrefix = False
End Select
End Function
'-------------------------------------
' Characters to be trimmed off end of word before spell checking
Function IsPermissibleSuffix(iChar As Integer) As Boolean
' Exclamation mark ! 33
' Symmetric double quote " 34
' Apostrophe ' 39
' Right parenthesis ) 41
' Comma , 44
' Full stop . 46
' Colon : 58
' Semicolon ; 59
' Question mark ? 63
' Right square bracket ] 93
' Right curly bracket } 125
' Right double angle quotation marks » 187
' Right single quotation mark ‘ 8217
' Right double quotation mark “ 8221
Select Case iChar
Case 33, 34, 39, 41, 44, 46, 58, 59, 63, 93, 125, 187, 8217, 8221
IsPermissibleSuffix = True
Case Else
IsPermissibleSuffix = False
End Select
End Function
'-------------------------------------
Function TrimWord( sWord As String) As String
Dim n as Integer
n = Len(sWord)
If n > 0 Then
Dim m as Integer : m = 1
Do While IsPermissiblePrefix( ASC(Mid(sWord, m, 1) ) ) And m <= n
m = m + 1
Loop
Do While IsPermissibleSuffix( ASC(Mid(sWord, n, 1) ) ) And n >= 1
n = n - 1
Loop
If n > m Then
TrimWord = Mid(sWord, m, (n + 1) - m)
Else
TrimWord = sWord
End If
Else
TrimWord = ""
End If
End Function
看起来问题是由函数 TrimWord 中的一个 while 循环引起的，它在将单词提供给 spell-check 服务之前删除了单词前后的标点符号。如果单词只有一个字符长，并且它是一个有效的标点符号，则循环开始时的条件为真，因此进入循环并且计数器 n 递减为零。然后在循环的下一次遍历开始时，即使条件无论如何都是假的，它仍然要求 Mid 函数 return 单词的第 0 个字符，它不能这样做，因为字符从 1 开始编号，因此会引发错误。如果可以从表达式的其他部分明确地确定条件的真值，则某些语言会忽略该错误。看起来 BASIC 不会那样做。
函数的以下修改版本以一种相当不优雅的方式解决了这个问题，但它似乎有效：
Function TrimWord(sWord As String) As String
Dim n as Long
n = Len(sWord)
If n > 0 Then
Dim m as Long : m = 1
Dim bTest As Boolean
bTest = m <= n
Do While IsPermissiblePrefix( ASC(Mid(sWord, m, 1) ) ) And bTest
if (m < n) Then
m = m + 1
Else
bTest = False
End If
Loop
bTest = n > 0
Do While IsPermissibleSuffix( ASC(Mid(sWord, n, 1) ) ) And bTest
if (n > 1) Then
n = n - 1
Else
bTest = False
End If
Loop
If n > m Then
TrimWord = Mid(sWord, m, (n + 1) - m)
Else
TrimWord = sWord
End If
Else
TrimWord = ""
End If
End Function
这对我有用。
根据google组，此宏可用于打印MS office中拼写错误的单词。
https://groups.google.com/g/microsoft.public.word.spelling.grammar/c/OiFYPkLAbeU
libre-office writer中有类似的选项吗？
以下子例程复制了 Google 组中代码的作用。它比 MS 版本更冗长，但在 LibreOffice / OpenOffice 中是可以预料到的。它只检查拼写检查行，而不检查绿色语法检查行，Google 组中的 MS 版本也是如此。
Sub UnderlineMisspelledWords
' From OOME Listing 315 Page 336
GlobalScope.BasicLibraries.loadLibrary( "Tools" )
Dim sLocale As String
sLocale = GetRegistryKeyContent("org.openoffice.Setup/L10N", FALSE).getByName("ooLocale")
' ooLocale appears to return a string that consists of the language and country
' seperated by a dash, e.g. en-GB
Dim nDash As Integer
nDash = InStr(sLocale, "-")
Dim aLocale As New com.sun.star.lang.Locale
aLocale.Language = Left(sLocale, nDash - 1)
aLocale.Country = Right(sLocale, Len(sLocale) -nDash )
Dim oSpeller As Variant
oSpeller = createUnoService("com.sun.star.linguistic2.SpellChecker")
Dim emptyArgs() as new com.sun.star.beans.PropertyValue
Dim oCursor As Object
oCursor = ThisComponent.getText.createTextCursor()
oCursor.gotoStart(False)
oCursor.collapseToStart()
Dim s as String, bTest As Boolean
Do
oCursor.gotoEndOfWord(True)
s = oCursor.getString()
bTest = oSpeller.isValid(s, aLocale, emptyArgs())
If Not bTest Then
With oCursor
.CharUnderlineHasColor = True
.CharUnderlineColor = RGB(255, 0,0)
.CharUnderline = com.sun.star.awt.FontUnderline.WAVE
' Possible alternatives include SMALLWAVE, DOUBLEWAVE and BOLDWAVE
End With
End If
Loop While oCursor.gotoNextWord(False)
End Sub
这会将字体的实际格式更改为带有红色波浪下划线，这将像任何其他格式一样打印出来。如果文档中任何拼写错误的单词已经带有某种下划线，那么它将会丢失。
您可能希望在打印后删除下划线。以下 Sub 仅在其样式与第一个例程添加的行的样式完全匹配的地方删除下划线。
Sub RemoveUnderlining
Dim oCursor As Object
oCursor = ThisComponent.getText.createTextCursor()
oCursor.gotoStart(False)
oCursor.collapseToStart()
Dim s as String, bTest As Boolean
Do
oCursor.gotoEndOfWord(True)
Dim bTest1 As Boolean
bTest1 = False
If oCursor.CharUnderlineHasColor = True Then
bTest1 = True
End If
Dim bTest2 As Boolean
bTest2 = False
If oCursor.CharUnderlineColor = RGB(255, 0,0) Then
bTest2 = True
End If
Dim bTest3 As Boolean
bTest3 = False
If oCursor.CharUnderline = com.sun.star.awt.FontUnderline.WAVE Then
bTest3 = True
End If
If bTest1 And bTest2 And bTest3 Then
With oCursor
.CharUnderlineHasColor = False
.CharUnderline = com.sun.star.awt.FontUnderline.NONE
End With
End If
Loop While oCursor.gotoNextWord(False)
End Sub
这不会恢复任何被红色波浪形下划线替换的原始下划线。删除波浪线以恢复这些波浪线的其他方法是：
按
undo(Ctrl Z)，但您需要为文档中的每个单词执行一次，这可能会有点麻烦。运行 子程序
UnderlineMisspelledWords临时复制文档然后打印后丢弃。
希望这就是您要找的。
针对您的上述评论，直接修改上述子例程即可，而不是绘制波浪线。下面的代码打开一个新的 Writer 文档，并将拼写错误的单词列表以及拼写检查器建议的替代词写入其中：
Sub ListMisSpelledWords
' From OOME Listing 315 Page 336
GlobalScope.BasicLibraries.loadLibrary( "Tools" )
Dim sLocale As String
sLocale = GetRegistryKeyContent("org.openoffice.Setup/L10N", FALSE).getByName("ooLocale")
' ooLocale appears to return a string that consists of the language and country
' seperated by a dash, e.g. en-GB
Dim nDash As Integer
nDash = InStr(sLocale, "-")
Dim aLocale As New com.sun.star.lang.Locale
aLocale.Language = Left(sLocale, nDash - 1)
aLocale.Country = Right(sLocale, Len(sLocale) -nDash )
Dim oSource As Object
oSource = ThisComponent
Dim oSourceCursor As Object
oSourceCursor = oSource.getText.createTextCursor()
oSourceCursor.gotoStart(False)
oSourceCursor.collapseToStart()
Dim oDestination As Object
oDestination = StarDesktop.loadComponentFromURL( "private:factory/swriter", "_blank", 0, Array() )
Dim oDestinationText as Object
oDestinationText = oDestination.getText()
Dim oDestinationCursor As Object
oDestinationCursor = oDestinationText.createTextCursor()
Dim oSpeller As Object
oSpeller = createUnoService("com.sun.star.linguistic2.SpellChecker")
Dim oSpellAlternatives As Object, emptyArgs() as new com.sun.star.beans.PropertyValue
Dim sMistake as String, oSpell As Object, sAlternatives() as String, bTest As Boolean, s As String, i as Integer
Do
oSourceCursor.gotoEndOfWord(True)
sMistake = oSourceCursor.getString()
bTest = oSpeller.isValid(sMistake, aLocale, emptyArgs())
If Not bTest Then
oSpell = oSpeller.spell(sMistake, aLocale, emptyArgs())
sAlternatives = oSpell.getAlternatives()
s = ""
for i = LBound(sAlternatives) To Ubound(sAlternatives) - 1
s = s & sAlternatives(i) & ", "
Next i
s = s & sAlternatives(Ubound(sAlternatives))
oDestinationText.insertString(oDestinationCursor, sMistake & ": " & s & Chr(13), False)
End If
Loop While oSourceCursor.gotoNextWord(False)
End Sub
我不知道字典，但是，为了回答您之前的评论，如果您将以下代码粘贴到 Loop While 下方和 End Sub 上方，它将导致文本出现在新的打开的 Writer 文档正在排序，没有重复项。它不是很优雅，但它适用于我试过的文本。
oDestinationCursor.gotoStart(False)
oDestinationCursor.gotoEnd(True)
Dim oSortDescriptor As Object
oSortDescriptor = oDestinationCursor.createSortDescriptor()
oDestinationCursor.sort(oSortDescriptor)
Dim sParagraphToBeChecked As String
Dim sThisWord As String
sThisWord = ""
Dim sPreviousWord As String
sPreviousWord = ""
oDestinationCursor.gotoStart(False)
oDestinationCursor.collapseToStart()
Dim k As Integer
Do
oDestinationCursor.gotoEndOfParagraph(True)
sParagraphToBeChecked = oDestinationCursor.getString()
k = InStr(sParagraphToBeChecked, ":")
If k <> 0 Then
sThisWord = Left(sParagraphToBeChecked, k-1)
End If
If StrComp(sThisWord, sPreviousWord, 0) = 0 Then
oDestinationCursor.setString("")
End If
sPreviousWord = sThisWord
Loop While oDestinationCursor.gotoNextParagraph(False)
Dim oReplaceDescriptor As Object
oReplaceDescriptor = oDestination.createReplaceDescriptor()
oReplaceDescriptor.setPropertyValue("SearchRegularExpression", TRUE)
oReplaceDescriptor.setSearchString("^$")
oReplaceDescriptor.setReplaceString("")
oDestination.replaceAll(oReplaceDescriptor)
我似乎没有发现这一点，因为我对其进行测试的文本只包含正确的或具有多个零备选词的词。我设法通过输入一个由拼写检查器无法建议任何替代字符的随机字符组成的单词来重现错误。如果找不到替代项，则函数 .getAlternatives() returns 大小为 -1 的数组，因此可以通过在使用数组之前测试此条件来避免错误。下面是子例程中第一个 Do 循环的修改版本，添加了这样的条件。如果用它替换现有循环，它应该会消除错误。
Do
oSourceCursor.gotoEndOfWord(True)
sMistake = oSourceCursor.getString()
bTest = oSpeller.isValid(sMistake, aLocale, emptyArgs())
If Not bTest Then
oSpell = oSpeller.spell(sMistake, aLocale, emptyArgs())
sAlternatives = oSpell.getAlternatives()
s = ""
If Ubound(sAlternatives) >= 0 Then
for i = LBound(sAlternatives) To Ubound(sAlternatives) - 1
s = s & sAlternatives(i) & ", "
Next i
s = s & sAlternatives(Ubound(sAlternatives))
End If
oDestinationText.insertString(oDestinationCursor, sMistake & ": " & s & Chr(13), False)
End If
Loop While oSourceCursor.gotoNextWord(False)
在重新阅读整个子例程时，我认为如果将变量 sMistake 重命名为 sWordToBeChecked 之类的内容会提高其可读性，因为该变量包含的字符串并不总是拼写错误。这当然需要在例程中的任何地方进行更改，而不仅仅是在上面的代码片段中。
下面是使用 Jim K 在其回答
Sub ListMisSpelledWords2
' From OOME Listing 315 Page 336
GlobalScope.BasicLibraries.loadLibrary( "Tools" )
Dim sLocale As String
sLocale = GetRegistryKeyContent("org.openoffice.Setup/L10N", FALSE).getByName("ooLocale")
' ooLocale appears to return a string that consists of the language and country
' seperated by a dash, e.g. en-GB
Dim nDash As Integer
nDash = InStr(sLocale, "-")
Dim aLocale As New com.sun.star.lang.Locale
aLocale.Language = Left(sLocale, nDash - 1)
aLocale.Country = Right(sLocale, Len(sLocale) -nDash )
Dim oSourceDocument As Object
oSourceDocument = ThisComponent
Dim nWordCount as Integer
nWordCount = oSourceDocument.WordCount
Dim oFrame As Object, oViewCursor As Object
With oSourceDocument.getCurrentController
oFrame = .getFrame()
oViewCursor = .getViewCursor()
End With
Dim oDispatcher as Object
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oDispatcher.executeDispatch(oFrame, ".uno:GoToStartOfDoc", "", 0, Array())
Dim oDestinationDocument As Object
oDestinationDocument = StarDesktop.loadComponentFromURL( "private:factory/swriter", "_blank", 0, Array() )
Dim oDestinationText as Object
oDestinationText = oDestinationDocument.getText()
Dim oDestinationCursor As Object
oDestinationCursor = oDestinationText.createTextCursor()
Dim oSpeller As Object
oSpeller = createUnoService("com.sun.star.linguistic2.SpellChecker")
Dim oSpellAlternatives As Object, emptyArgs() as new com.sun.star.beans.PropertyValue
Dim sMistake as String, oSpell As Object, sAlternatives() as String, bTest As Boolean, s As String, i as Integer
For i = 0 To nWordCount - 1
oDispatcher.executeDispatch(oFrame, ".uno:WordRightSel", "", 0, Array())
sWordToBeChecked = RTrim( oViewCursor.String )
bTest = oSpeller.isValid(sWordToBeChecked, aLocale, emptyArgs())
If Not bTest Then
oSpell = oSpeller.spell(sWordToBeChecked, aLocale, emptyArgs())
sAlternatives = oSpell.getAlternatives()
s = ""
If Ubound(sAlternatives) >= 0 Then
for i = LBound(sAlternatives) To Ubound(sAlternatives) - 1
s = s & sAlternatives(i) & ", "
Next i
s = s & sAlternatives(Ubound(sAlternatives))
End If
oDestinationText.insertString(oDestinationCursor, sWordToBeChecked & ": " & s & Chr(13), False)
End If
oDispatcher.executeDispatch(oFrame, ".uno:GoToPrevWord", "", 0, Array())
oDispatcher.executeDispatch(oFrame, ".uno:GoToNextWord", "", 0, Array())
Next i
oDestinationCursor.gotoStart(False)
oDestinationCursor.gotoEnd(True)
' Sort the paragraphs
Dim oSortDescriptor As Object
oSortDescriptor = oDestinationCursor.createSortDescriptor()
oDestinationCursor.sort(oSortDescriptor)
' Remove duplicates
Dim sParagraphToBeChecked As String, sThisWord As String, sPreviousWord As String
sThisWord = ""
sPreviousWord = ""
oDestinationCursor.gotoStart(False)
oDestinationCursor.collapseToStart()
Dim k As Integer
Do
oDestinationCursor.gotoEndOfParagraph(True)
sParagraphToBeChecked = oDestinationCursor.getString()
k = InStr(sParagraphToBeChecked, ":")
If k <> 0 Then
sThisWord = Left(sParagraphToBeChecked, k-1)
End If
If StrComp(sThisWord, sPreviousWord, 0) = 0 Then
oDestinationCursor.setString("")
End If
sPreviousWord = sThisWord
Loop While oDestinationCursor.gotoNextParagraph(False)
' Remove empty paragraphs
Dim oReplaceDescriptor As Object
oReplaceDescriptor = oDestinationDocument.createReplaceDescriptor()
oReplaceDescriptor.setPropertyValue("SearchRegularExpression", TRUE)
oReplaceDescriptor.setSearchString("^$")
oReplaceDescriptor.setReplaceString("")
oDestinationDocument.replaceAll(oReplaceDescriptor)
End Sub
首先，针对您关于该错误的问题，我不是维护者，因此无法修复。但是，由于该错误涉及将文本光标移动到单词的开头和结尾，因此应该可以通过搜索单词之间的 white-space 来绕过它。由于 white-space 字符（我认为）在所有语言中都是相同的，因此从某些字母表中识别某些字符的任何问题都无关紧要。最简单的方法是首先将文档的整个文本读入一个字符串，但 LibreOffice 字符串的最大长度为 2^16 = 65536 个字符，虽然这看起来很多，但对于一个合理的大小的文档。可以通过一次一个段落地浏览文本来避免该限制。根据 Andrew Pitonyak（OOME 第 388 页）的说法：“我发现 gotoNextSentence() 和 gotoNextWord() 不可靠，但段落光标运行良好。”
下面的代码是对之前答案中子程序的又一次修改。这次它从段落中获取一个字符串，并通过找到单词之间的 white-space 将其拆分为单词。然后它像以前一样拼写检查单词。该子例程依赖于它下面列出的一些其他函数。这些允许您指定将哪些字符指定为单词分隔符（即 white-space），以及在单词的开头或结尾发现哪些字符要忽略。这是必要的，例如，引号周围的引号不计为单词的一部分，即使引号内的单词拼写正确，这也会导致它被识别为拼写错误。
我不熟悉非拉丁字母，也没有安装合适的词典，但我粘贴了你问题
关于查找同义词的问题，由于每个拼错的单词都有多个建议，而每个建议都有多个同义词，因此输出可能会很快变得非常大且令人困惑。如果您的用户想使用不同的词，最好单独查找它们。
Sub ListMisSpelledWords3
' From OOME Listing 315 Page 336
GlobalScope.BasicLibraries.loadLibrary( "Tools" )
Dim sLocale As String
sLocale = GetRegistryKeyContent("org.openoffice.Setup/L10N", FALSE).getByName("ooLocale")
' ooLocale appears to return a string that consists of the language and country
' seperated by a dash, e.g. en-GB
Dim nDash As Integer
nDash = InStr(sLocale, "-")
Dim aLocale As New com.sun.star.lang.Locale
aLocale.Language = Left( sLocale, nDash - 1)
aLocale.Country = Right( sLocale, Len(sLocale) - nDash )
Dim oSource As Object
oSource = ThisComponent
Dim oSourceCursor As Object
oSourceCursor = oSource.getText.createTextCursor()
oSourceCursor.gotoStart(False)
oSourceCursor.collapseToStart()
Dim oDestination As Object
oDestination = StarDesktop.loadComponentFromURL( "private:factory/swriter", "_blank", 0, Array() )
Dim oDestinationText as Object
oDestinationText = oDestination.getText()
Dim oDestinationCursor As Object
oDestinationCursor = oDestinationText.createTextCursor()
Dim oSpeller As Object
oSpeller = createUnoService("com.sun.star.linguistic2.SpellChecker")
Dim oSpellAlternatives As Object, emptyArgs() as new com.sun.star.beans.PropertyValue
Dim sWordToCheck as String, oSpell As Object, sAlternatives() as String, bTest As Boolean
Dim s As String, i as Integer, j As Integer, sParagraph As String, nWordStart As Integer, nWordEnd As Integer
Dim nChar As Integer
Do
oSourceCursor.gotoEndOfParagraph(True)
sParagraph = oSourceCursor.getString() & " " 'It is necessary to add a space to the end of
'the string otherwise the last word of the paragraph is not recognised.
nWordStart = 1
nWordEnd = 1
For i = 1 to Len(sParagraph)
nChar = ASC(Mid(sParagraph, i, 1))
If IsWordSeparator(nChar) Then '1
If nWordEnd > nWordStart Then '2
sWordToCheck = TrimWord( Mid(sParagraph, nWordStart, nWordEnd - nWordStart) )
bTest = oSpeller.isValid(sWordToCheck, aLocale, emptyArgs())
If Not bTest Then '3
oSpell = oSpeller.spell(sWordToCheck, aLocale, emptyArgs())
sAlternatives = oSpell.getAlternatives()
s = ""
If Ubound(sAlternatives) >= 0 Then '4
for j = LBound(sAlternatives) To Ubound(sAlternatives) - 1
s = s & sAlternatives(j) & ", "
Next j
s = s & sAlternatives(Ubound(sAlternatives))
End If '4
oDestinationText.insertString(oDestinationCursor, sWordToCheck & " : " & s & Chr(13), False)
End If '3
End If '2
nWordEnd = nWordEnd + 1
nWordStart = nWordEnd
Else
nWordEnd = nWordEnd + 1
End If '1
Next i
Loop While oSourceCursor.gotoNextParagraph(False)
oDestinationCursor.gotoStart(False)
oDestinationCursor.gotoEnd(True)
Dim oSortDescriptor As Object
oSortDescriptor = oDestinationCursor.createSortDescriptor()
oDestinationCursor.sort(oSortDescriptor)
Dim sParagraphToBeChecked As String
Dim sThisWord As String
sThisWord = ""
Dim sPreviousWord As String
sPreviousWord = ""
oDestinationCursor.gotoStart(False)
oDestinationCursor.collapseToStart()
Dim k As Integer
Do
oDestinationCursor.gotoEndOfParagraph(True)
sParagraphToBeChecked = oDestinationCursor.getString()
k = InStr(sParagraphToBeChecked, ":")
If k <> 0 Then
sThisWord = Left(sParagraphToBeChecked, k-1)
End If
If StrComp(sThisWord, sPreviousWord, 0) = 0 Then
oDestinationCursor.setString("")
End If
sPreviousWord = sThisWord
Loop While oDestinationCursor.gotoNextParagraph(False)
Dim oReplaceDescriptor As Object
oReplaceDescriptor = oDestination.createReplaceDescriptor()
oReplaceDescriptor.setPropertyValue("SearchRegularExpression", TRUE)
oReplaceDescriptor.setSearchString("^$")
oReplaceDescriptor.setReplaceString("")
oDestination.replaceAll(oReplaceDescriptor)
End Sub
'----------------------------------------------------------------------------
' From OOME Listing 360.
Function IsWordSeparator(iChar As Integer) As Boolean
' Horizontal tab \t 9
' New line \n 10
' Carriage return \r 13
' Space 32
' Non-breaking space 160
Select Case iChar
Case 9, 10, 13, 32, 160
IsWordSeparator = True
Case Else
IsWordSeparator = False
End Select
End Function
'-------------------------------------
' Characters to be trimmed off beginning of word before spell checking
Function IsPermissiblePrefix(iChar As Integer) As Boolean
' Symmetric double quote " 34
' Left parenthesis ( 40
' Left square bracket [ 91
' Back-tick ` 96
' Left curly bracket { 123
' Left double angle quotation marks « 171
' Left single quotation mark ‘ 8216
' Left single reversed 9 quotation mark ‛ 8219
' Left double quotation mark “ 8220
' Left double reversed 9 quotation mark ‟ 8223
Select Case iChar
Case 34, 40, 91, 96, 123, 171, 8216, 8219, 8220, 8223
IsPermissiblePrefix = True
Case Else
IsPermissiblePrefix = False
End Select
End Function
'-------------------------------------
' Characters to be trimmed off end of word before spell checking
Function IsPermissibleSuffix(iChar As Integer) As Boolean
' Exclamation mark ! 33
' Symmetric double quote " 34
' Apostrophe ' 39
' Right parenthesis ) 41
' Comma , 44
' Full stop . 46
' Colon : 58
' Semicolon ; 59
' Question mark ? 63
' Right square bracket ] 93
' Right curly bracket } 125
' Right double angle quotation marks » 187
' Right single quotation mark ‘ 8217
' Right double quotation mark “ 8221
Select Case iChar
Case 33, 34, 39, 41, 44, 46, 58, 59, 63, 93, 125, 187, 8217, 8221
IsPermissibleSuffix = True
Case Else
IsPermissibleSuffix = False
End Select
End Function
'-------------------------------------
Function TrimWord( sWord As String) As String
Dim n as Integer
n = Len(sWord)
If n > 0 Then
Dim m as Integer : m = 1
Do While IsPermissiblePrefix( ASC(Mid(sWord, m, 1) ) ) And m <= n
m = m + 1
Loop
Do While IsPermissibleSuffix( ASC(Mid(sWord, n, 1) ) ) And n >= 1
n = n - 1
Loop
If n > m Then
TrimWord = Mid(sWord, m, (n + 1) - m)
Else
TrimWord = sWord
End If
Else
TrimWord = ""
End If
End Function
看起来问题是由函数 TrimWord 中的一个 while 循环引起的，它在将单词提供给 spell-check 服务之前删除了单词前后的标点符号。如果单词只有一个字符长，并且它是一个有效的标点符号，则循环开始时的条件为真，因此进入循环并且计数器 n 递减为零。然后在循环的下一次遍历开始时，即使条件无论如何都是假的，它仍然要求 Mid 函数 return 单词的第 0 个字符，它不能这样做，因为字符从 1 开始编号，因此会引发错误。如果可以从表达式的其他部分明确地确定条件的真值，则某些语言会忽略该错误。看起来 BASIC 不会那样做。
函数的以下修改版本以一种相当不优雅的方式解决了这个问题，但它似乎有效：
Function TrimWord(sWord As String) As String
Dim n as Long
n = Len(sWord)
If n > 0 Then
Dim m as Long : m = 1
Dim bTest As Boolean
bTest = m <= n
Do While IsPermissiblePrefix( ASC(Mid(sWord, m, 1) ) ) And bTest
if (m < n) Then
m = m + 1
Else
bTest = False
End If
Loop
bTest = n > 0
Do While IsPermissibleSuffix( ASC(Mid(sWord, n, 1) ) ) And bTest
if (n > 1) Then
n = n - 1
Else
bTest = False
End If
Loop
If n > m Then
TrimWord = Mid(sWord, m, (n + 1) - m)
Else
TrimWord = sWord
End If
Else
TrimWord = ""
End If
End Function
这对我有用。