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

我想替换另一个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匹配的错误。

---

而且，由于拼写检查器似乎排除了所有非单词字符，因此这些符号也被视为非错误且加粗。也许我需要插入一个正则表达式来处理这个问题

我自己来回答这个问题：恐怕确实没有解决办法——据我在网上找到的判断，不能排除主词典

但是，我找到了一个完全不同的解决方案，它实际上也有同样的效果，对我来说已经足够好了

'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

---

你已经接近你的第一个解决方案了。诀窍是，您必须将自定义词典存储在Word默认目录之外的某个位置，否则Word会将所有词典合并在一起进行拼写检查。与第二种解决方案类似，您必须手动将单词添加到自定义词典中，例如使用记事本

因此，将自定义词典复制到另一个位置，例如我的文档。Office 2010中的自定义词典位于C:\Users\USERNAME\AppData\Roaming\Microsoft\Outlof中。接下来，从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

---

这个愚蠢的论坛不允许我上传图片，但这里有一个。请注意，红色CustomDict样式已应用于我添加到自定义词典中的单词Fleurgy。

@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

---

您好，非常感谢您的回复-但我认为手动从列表中删除自定义dict是没有选择的。难道没有一种方法可以通过编程实现吗？