libreoffice - 你能打印 writer 拼写检查生成的波浪线吗？

Question

根据 google group，此宏可用于打印 MS office 中拼写错误的单词。

https://groups.google.com/g/microsoft.public.word.spelling.grammar/c/OiFYPkLAbeU

libre-office writer有类似的选项吗？

Answer 1

以下子例程复制了 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

这不会恢复任何被红色波浪形下划线替换的原始下划线。删除波浪线以恢复这些波浪线的其他方法是:

1. 按下 undo (Ctrl Z) 但您需要为文档中的每个单词执行一次，这可能会有点麻烦。

2. 运行子程序 UnderlineMisspelledWords在文档的临时副本上，然后在打印后将其丢弃。

我希望这就是您要找的。