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中，此列表位于文件＆gt;选项＆gt;打样＆gt;自定义词典。从列表中选择自定义词典，然后单击“删除”。

现在，修改后的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

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

3 个答案: