MS Word 2003 VBA - 只使用自定义字典替换（非）拼写错误中的格式

Question

我想替换另一个txt文件中与单词匹配的单词的格式。 我尝试了几件事，但终于找到了我认为最有效的解决方案。

这里的未令人满意的工作，因为主要的字典没有被禁用的代码...

Sub format_dict_words() 

Dim rngWord As Range 

DoEvents 

For Each rngWord In ActiveDocument.Range.Words 
DoEvents 
If Application.CheckSpelling(_ 
    Word:=rngWord.Text, _ 
    customdictionary:="I:\NATUR\Kay\DIC\test.DIC", _ 
    MainDictionary:="I:\NATUR\Kay\DIC\test.DIC", _ 
    IgnoreUppercase:=False) = True Then 
    rngWord.Bold = True 
End If 
Next rngWord 

End Sub 

我需要禁用主词典，则非拼写错误实际上仅与我的test.DIC匹配。 而且，由于拼写检查程序似乎排除了所有不是单词字符的内容，因此这些符号也被视为非错误且粗体显示。也许我需要插入一个正则表达式来处理这个问题。

Answer 1

我会自己回答这个问题：恐怕这确实没有解决方案 - 据我可以从我发现的网主字典不能排除..

但是，我来到了一个完全不同的解决方案，它实际上做同样的工作，并不够好，我..

'macro name: ReformatListMatches 
'purpose: compares words from document with words from file 
'author: kay cichini 
'date: 2012-01-04 
'licence: cc by-nc-sa 

'specifications: 
'before running the macro, add a commandbar called "mycombar" and assign the macro "ReformatListMatches" to it, 
'run line 8 one time, then disable it, then save file to a template (.dot) and store it at your templates' folder. 
'if you don't want a command bar, just skip the above part and don't run line 8! 

Sub ReformatListMatches() 

'CommandBars("mycombar").Controls(1).TooltipText = "calls procedure that re-formats words that match word list" 
'this sets tooltip info, run this only once (!!), otherwise you will be asked to save changes to the dot file 
'everytime you close a word doc. 

time_start = Timer() 

If MsgBox("Re-format matches?" & vbLf & " " & vbLf & "..may take some time" & vbLf & "..be patient! (the active window will be temporarily invisible to speed up process)", vbOKCancel + vbQuestion, "SpKursiv") = vbOK Then 

Dim vntArrWords As Variant 
Dim lngI As Long 
Dim strText As String 
Dim strPathFile As String 
Dim lngFN As Long 

strPathFile = "C:\LogoXP\SP_words_tab.txt" 
'the database with names to compare 

lngFN = FreeFile 
Open strPathFile For Binary As lngFN 
strText = Space(LOF(lngFN)) 
Get lngFN, 1, strText 
Close lngFN 

System.Cursor = wdCursorWait 

vntArrWords = Split(strText, vbCrLf, -1, 1) 

ActiveWindow.Visible = False 

With ActiveDocument.Content.Find 
    .ClearFormatting 
    .Forward = True 
    .Wrap = wdFindContinue 
    .Format = True 
    .MatchCase = False 
    .MatchWholeWord = True 
    .MatchWildcards = False 
    .MatchSoundsLike = False 
    .MatchAllWordForms = False 
    .Replacement.ClearFormatting 
    .Replacement.Text = "^&"    'replaces match with the original string (but with new format!) 
    .Replacement.Font.Italic = True  'here i determine the new format 
    For lngI = 0 To UBound(vntArrWords) 
    .Text = Trim(vntArrWords(lngI)) 
    .Execute Replace:=wdReplaceAll 
    Next 
End With 

ActiveWindow.Visible = True 

time_end = Timer() 

MsgBox "finished!" & vbLf & "(calculation time (mm:ss) = " & time_end - time_start & ")" 

Else: Exit Sub 
End If 

End Sub 

Answer 2

你是亲近第一个解决方案诀窍是，您必须将自定义字典存储在Word默认的“UProof”目录之外，否则Word会将所有字典混合在一起进行拼写检查。与第二种解决方案类似，您必须手动为自定义词典添加单词，例如使用记事本。

因此，将自定义词典复制到其他位置，例如“我的文档”。 Office 2010中的自定义词典位于C:\Users\USERNAME\AppData\Roaming\Microsoft\UProof。接下来，从Word的词典列表中删除自定义词典。在Office 2010中，此列表位于文件>选项>校对>自定义字典中。从列表中选择自定义词典，然后单击“删除”。

现在，这里的应适用的格式修改后的VBA代码（在这种情况下，所谓的CustomDict自定义样式）仅在搬迁的自定义字典中的字：

Option Explicit 

Sub CustomDictStyle() 

    Dim rngWord As Range 

    DoEvents 

    For Each rngWord In ActiveDocument.Range.Words 

     DoEvents 

     'Include words in custom dictionary 

     If Application.CheckSpelling(_ 
     Word:=rngWord.Text, _ 
     CustomDictionary:="C:\Users\USERNAME\Documents\CUSTOM.dic", _ 
     IgnoreUppercase:=False) = True Then 

      'Now exclude words in the main dictionary 

      If Application.CheckSpelling(_ 
       Word:=rngWord.Text, _ 
       IgnoreUppercase:=False) = False Then 

        'Apply style as desired 
        rngWord.Style = "CustomDict" 

      End If 

     End If 

    Next rngWord 

End Sub 

这愚蠢的论坛不会让我上传图像，但这是一个link to what it should look like。请注意，红色的“CustomDict”风格已应用于我添加到自定义词典中的“fleurghy”一词。

Answer 3

@Jeremy，我试图运用你的代码，但不知何故没有mydict.txt所有字都被重新格式化..

Option Explicit 

Sub CustomDictStyle() 

    Dim StartTime As Double, EndTime As Double 
    Dim rngWord As Range 

    'Stores start time in variable "StartTime" 
    StartTime = Timer 

    'remove custom dictionaries 
    CustomDictionaries.ClearAll 

    DoEvents 

    For Each rngWord In ActiveDocument.Range.Words 

     DoEvents 

     'Include words in custom dictionary 

     If Application.CheckSpelling(_ 
     Word:=rngWord.Text, _ 
     CustomDictionary:="C:\Dokumente und Einstellungen\kcichini\Eigene Dateien\Stuff\mydict.txt", _ 
     IgnoreUppercase:=False) = True Then 

      'Now exclude words in the main dictionary 

      If Application.CheckSpelling(_ 
       Word:=rngWord.Text, _ 
       IgnoreUppercase:=False) = False Then 

        'Apply style as desired 
        rngWord.Bold = True 

      End If 

     End If 

    Next rngWord 

    'restore custom dictionary 
    CustomDictionaries.Add FileName:="BENUTZER.DIC" 

    'Stores end time in variable "EndTime" 
    EndTime = Timer 

    'Prints execution time in the debug window 
    MsgBox ("Execution time in seconds: " & EndTime - StartTime) 

End Sub