使用宏删除 word 中文档开头和结尾引入的填充

Question

我目前正在编写一个宏，它将 Word 文档的内容与文本词典文件进行比较。它会突出显示所有匹配项，以便用户可以做出适当的更改。我对宏有点陌生，所以我使用了在网上找到的类似内容作为指南以及我的一般编码知识，但我不知道我需要的所有方法和对象。

我已将其设置为打开一个通用对话框来选择要比较的单词文件（字典文件是硬编码的，因为我不希望人们意外选择一个文件，因为它可能会被很多人使用）

对于中的每一行字典文件中，宏使用 hithighlight 方法突出显示文件中该单词的任何出现。我必须在单词周围放置空格，以确保只完成单个单词，因为字典包含许多首字母缩略词。

问题是，因此我必须在文档的开头和结尾处填充空格，以便也检查第一个和最后一个单词，但我不确定如何执行此操作。我已经进行了一些搜索，并且看到了一些有关使用不同选择的内容，但我不知道是否有用于选择的克隆方法，并且我确信如果我将另一个选择设置为等于我的选择，它只会复制对象的地址，这将使它变得毫无意义。

这是我的代码：

Documents(ActiveDocument.FullName).Close SaveChanges:=wdDoNotSaveChanges

'Values for objFSO
Const ForReading = 1
Const ColourYellow = 65535

Dim doc As Document
Dim DocRange As Range

'allows us to change the document in use
Set ObjCD = CreateObject("UserAccounts.CommonDialog")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")

'Relevant path to the Dictionary txt file, change this to point to the dictionary list if different to this
DicFilePath = "O:\IPS\PDU\KIS\Intranet\consistency-with-styleguide-project\styleguidelist.txt"

'Set the parameters for the Common Dialog
ObjCD.Filter = "Word Documents|*.docx" 'Filter only docx files
ObjCD.FilterIndex = 3
ObjCD.InitialDir = "" 'Set the initial path for the Common Dialog to the same folder as the script

'Display the File open dialog
InitFSO = ObjCD.ShowOpen

If InitFSO = False Then
    'No file was selected so Error
    MsgBox ("No file was selected")
Else
    'ScanFilePath =  the full path and filename if the file
    ScanFilePath = ObjCD.FileName

    Set doc = Documents.Open(ScanFilePath) 'store the document we want to check as doc
    Set objDicFile = objFSO.OpenTextFile(DicFilePath, ForReading) 'open the dictionary file

    With doc
        MatchFound = False 'initially have no matches found as haven't searched yet
        Set DocRange = .Range 'this represents the entire document
        DicWordCount = 0

        DocRange.InsertAfter (Space(1))
        DocRange.InsertBefore (Space(1))
        'do this to pad the start and end with spaces to allow matches for the first and last word
        'this is done as it's easier than having it look for start and end of file markers and still only find
        'whole words

        'Loop though each word in the dictionary and check if that word exists in the word doc
        Do While objDicFile.AtEndOfStream <> True
            'reset so EACH word in dictionary is checked for
            DicWordFound = False

            'Read the next word from the dictionary
            DicWord = objDicFile.ReadLine
            DicWord = Space(1) & DicWord & Space(1) 'add a space to both sides to find whole words only

            DicWordFound = DocRange.Find.HitHighlight(DicWord, ColourYellow)
            'is true if it was found at least once, else false. If any are found they are highlighted in yellow

            If DicWordFound Then
                MatchFound = True 'MatchFound if used to check if any match was found for any words, only false if none are found
            End If
        Loop

        'this is done to remove the superfluous space at the end.

    End With

    If MatchFound Then
        'If a Match is found

        'Display OK message
        MsgBox ("Complete: MATCH FOUND!" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Matches are highlighted in yellow.")
    Else
        'If a Match is NOT found
        MsgBox ("No Match")
    End If
End If

如果有人知道如何删除搜索完成后添加的填充，那将非常有帮助。或者，如果有人可以建议一种更有效的方法，我们将不胜感激。 （例如，我确信应该有一种方法仅在搜索时检查整个单词，但我不知道它，因为我是宏的新手）

此外，如果有人确定是否在单词中复制了相同的功能97-2003 使用相同的方法和对象让我知道，这样我就可以将其扩展到 .doc 文件，而无需任何额外的单词。

感谢您抽出时间。

Answer 1

您可以尝试录制宏，当您无法选择哪个是正确的时，这可以帮助查找对象或方法。

在您的情况下，您可以使用 Find 对象的 .MatchWholeWord 属性 (http://msdn.microsoft.com/en-us/library/bb226067.aspx) ：

DicWordFound = DocRange.Find.HitHighlight(DicWord, ColourYellow, MatchWholeWord = True)

但无法在此处检查它。

希望有帮助，

问候，

麦克斯