Question

我正在编写一个宏，它将word文档的内容与文本字典文件进行比较。它会突出显示所有匹配项，以便此人可以进行适当的更改。我是一个新的宏，所以我使用了类似的东西，我在网上找到了指南以及我的一般编码知识，但我不知道我需要的所有方法和对象。

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

对于字典文件中的每一行，宏使用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)

虽然无法在这里查看。

希望有所帮助，

此致

最高

使用宏将已引入的填充删除到文档的开头和结尾

1 个答案: