将新单词添加到Word VBA中的每个后续单元格

问题描述

我一直在研究这段代码，该代码从文档中提取拼写错误的单词，然后将它们变成一个表格，其中所有拼写错误的单词都位于一列。然后，对单词进行拼写检查，更正出现在另一列上。我的代码完成了我想要的所有操作，但是每个单元格上只出现第一个单词。我在做什么错了？

Sub SuperSpellCheck()
Dim doc1 As Document
Dim doc2 As Document
Dim tb As Table
Set doc1 = ActiveDocument
Set doc2 = Documents.Add
doc1.Activate
Dim badw As Range
Dim rng As Range
Dim sugg As SpellingSuggestions    
Dim sug As Variant
err = doc1.SpellingErrors.Count
For Each badw In doc1.SpellingErrors
doc2.Range.InsertAfter badw & vbCr
Next
doc2.Activate
Set tb = ActiveDocument.Content.ConvertToTable(Separator:=wdSeparateByParagraphs,NumColumns:=1,NumRows:=ActiveDocument.SpellingErrors.Count,AutoFitBehavior:=wdAutoFitFixed)
With tb
    .Style = "Table Grid"
     .ApplyStyleheadingRows = True
     .ApplyStyleLastRow = False
     .ApplyStyleFirstColumn = True
     .ApplyStyleLastColumn = False
     .Columns.Add
     .PreferredWidthType = wdPreferredWidthPercent
     .PreferredWidth = 100
  End With
err2 = ActiveDocument.SpellingErrors.Count
i = 1
Set sugg = doc2.Range.GetSpellingSuggestions
For Each rng In doc2.Range.SpellingErrors
With rng
If sugg.Count > 0 Then
Set sug = .GetSpellingSuggestions
tb.Cell(i,2).Range.InsertAfter sug(1)
End If
End With
Next
End Sub

解决方法

与您的问题无关，但您需要更改这些行

Err = doc1.SpellingErrors.Count
err2 = ActiveDocument.SpellingErrors.Count

收件人：

Dim errors1 as Long,dim errors2 as Long
errors1 = doc1.SpellingErrors.Count
errors2 = doc2.SpellingErrors.Count

Err是VBA中的一个对象，其中包含您的代码生成的错误。您还没有声明这些变量。在代码模块的最顶部添加Option Explicit，您将收到未声明变量的警告。要在以后自动将其打开，请转到“工具|选项|编辑器，并确保选中了“需要变量声明”。

我会改变

Dim sugg As SpellingSuggestions    
Dim sug As Variant

到

   Dim docSugg As SpellingSuggestions
   Dim rngSugg As SpellingSuggestions
   Dim sug As SpellingSuggestion

这将使它们分别代表的含义更加清楚。 SpellingSuggestions是SpellingSuggestion对象的集合，因此您可以使用sug遍历该集合。

   i = 1
   Set sugg = doc2.Range.GetSpellingSuggestions
   For Each rng In doc2.Range.SpellingErrors
      With rng
         If sugg.Count > 0 Then
            Set sug = .GetSpellingSuggestions
            tb.Cell(i,2).Range.InsertAfter sug(1)
         End If
      End With
   Next

在此代码块中，您首先将未声明的变量i设置为1，但随后不增加该值。这将导致所有拼写建议都插入到同一单元格中。另外，插入拼写建议时，您只能插入第一个，因为您没有办法遍历它们。所以我将其重写为：

   i = 1
   Set docSugg = doc2.Range.GetSpellingSuggestions
   For Each rng In doc2.Range.SpellingErrors
      With rng
         If docSugg.Count > 0 Then
            Set rngSugg = .GetSpellingSuggestions
            For Each sug In rngSugg
               tb.Cell(i,2).Range.InsertAfter sug
            Next
         End If
      End With
      i = i + 1
   Next

编辑：如果只希望第一个建议的拼写，请使用：

   i = 1
   Set docSugg = doc2.Range.GetSpellingSuggestions
   For Each rng In doc2.Range.SpellingErrors
      With rng
         If docSugg.Count > 0 Then
            Set rngSugg = .GetSpellingSuggestions
            tb.Cell(i,2).Range.InsertAfter rngSugg(1)
         End If
      End With
      i = i + 1
   Next