向 Word 中的每个后续单元格添加一个新词 VBA

Adding a new word to each subsequent cell in Word VBA

我一直在研究这段代码,它从文档中提取拼写错误的单词,然后将它们变成一个 table,所有拼写错误的单词都在一列中。然后对单词进行拼写检查,更正出现在另一列中。我的代码做我想做的一切,但是每个单元格上只出现第一个词。我做错了什么?

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

这将使每个人更清楚地代表什么。 SpellingSuggestionsSpellingSuggestion 个对象的集合,因此您可以使用 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