在word VBA中为每个后续单元格添加一个新词

Question

我一直在编写这段代码，它从文档中提取拼写错误的单词，然后将它们转换成一个表，在一列中包含所有拼写错误的词。然后对单词进行拼写检查，并将更正显示在另一列。我的代码执行我希望它执行的所有操作，但是每个单元格上只显示第一个单词。我做错了什么？

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

Answer 1

未连接到您的问题，但您需要更改这些行

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