使用Word中的VBA标记文档中的特殊字符

时间:2017-02-28 20:08:21

标签: word-vba

我完全失去了处理这个过程的更好方法。

以下宏分析文档中的每个字符,如果ASCII值高于255,则会对其应用特殊字符样式 - 某些字符样式适用于特定语言,或者仅适用于' lang'如果它不是那些语言的一部分。

宏工作正常,但在长文档上,处理时需要花费很长时间。例如,我刚刚在每个页面上处理了一个147页(单行间距)文档,其中包含几行希腊语,在Word 2016 for Windows中花了40分钟(相比之下,完全相同的文件和相同的代码花了2分钟在Mac上。)

我可以对下面的代码做些什么来为Windows优化这个吗?

感谢您的任何建议。 约翰

8!==8

1 个答案:

答案 0 :(得分:0)

由于某种原因,Range.DetectLanguage似乎不适用于我的Word(2007)版本,但这可能需要考虑而不是检查字符代码。

加速Office VBA宏的一般方法是禁用屏幕更新:

Application.ScreenUpdating = False
' some slow code that causes the screen to be updated
Application.ScreenUpdating = True 

这应该对你的情况有所帮助,因为你使用较慢的Selection而不是Range

另外,直接检查字节值似乎比AscW快一点:

Sub test()
    'Options.DefaultHighlightColorIndex = wdNoHighlight
    'Range.HighlightColorIndex = wdNoHighlight ' used for testing to clear Highlight

    Dim r As Range, t As Double: t = Timer
    Application.ScreenUpdating = False

    For Each r In Range.Characters ' For Each r In Range.Words is somehow about 2 times slower than .Characters
        checkRange r
    Next

    Application.ScreenUpdating = True
    Debug.Print Timer - t; Range.Words.Count; Range.Characters.Count; Range.End ' " 3.15625  8801  20601  20601 "
End Sub

Sub checkRange(r As Range)
    Dim b() As Byte, i As Long, a As Long
    b = r.Text ' converts the string to byte array (2 or 4 bytes per character)
    'Debug.Print "'" & r & "'"; r.LanguageID; r.LanguageIDFarEast; r.LanguageIDOther

    For i = 1 To UBound(b) Step 2            ' 2 bytes per Unicode codepoint
        If b(i) > 0 Then                     ' if AscW > 255
            a = b(i): a = a * 256 + b(i - 1) ' AscW
            Select Case a
                Case &H1F00 To &H1FFF: r.HighlightColorIndex = wdBlue: Exit Sub ' Greek Extended
                Case &H3040 To &H30FF: r.HighlightColorIndex = wdPink: Exit Sub ' Hiragana and Katakana
                Case &H4E00 To 40959: r.HighlightColorIndex = wdGreen: Exit Sub ' CJK Unified Ideographs

                Case 55296 To 56319: ' ignore leading High Surrogates ?
                Case 56320 To 57343: ' ignore trailing Low Surrogates ?

                Case Else: r.HighlightColorIndex = wdRed: Debug.Print Hex(a), r.End - r.Start ' other
            End Select
        End If
    Next
End Sub

您的代码中很少有像8190这样的Unicode代码点似乎有点关闭,所以您可以在 http://www.fileformat.info/info/unicode/block/index.htm