2011-06-10 30 views
1

我目前正在編寫一個宏,比較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 

如果有人知道我怎麼能刪除我加了一次,我做了搜索,這將是非常有幫助的填充。另外,如果有人可以建議更有效的方式,將不勝感激。 (例如,我確定應該有一種方法來檢查整個單詞只有當搜索,但我不知道它,因爲我是新的宏)

此外,如果有人知道肯定是否相同的功能被複制到Word 97-2003使用相同的方法和對象讓我知道,這樣我可以將它擴展到.doc文件沒有任何額外的單詞。

感謝您的時間。

回答

1

你可以嘗試記錄宏,這可以幫助找到對象或方法,當你不能選擇哪個是正確的。

在你的情況,你可以使用Find對象的.MatchWholeWord財產(http://msdn.microsoft.com/en-us/library/bb226067.aspx):

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

未能進行雖然在這裏檢查它。

希望幫助,

問候,

最大

+0

完美的,我知道,會是一個更好的方式來做到這一點,這是非常令人沮喪的知道,一定有一個正確的方法來做到這一點,但由於缺乏對宏的練習,必須以一種愚蠢的方式去做。 它找到正確的詞到處都包括開始和結束,並僅限於整個單詞。非常感謝。 – WizzPhiz 2011-06-20 00:17:03