循环浏览Excel行，在Word中输入值，粘贴Excel字符串

我正在尝试遍历Excel行，其中A列包含我想在Word中查找的文本。B列包含我要在Word中找到文本的段落结尾后粘贴的内容

在Word VBA中工作时，“查找”文本有效，并移动到段落末尾。但是当我转到ExcelVBA时，find方法似乎什么都没有做

Sub UpdateWordDoc1()

Dim mywb As Excel.Worksheet
Set mywb = ActiveWorkbook.ActiveSheet
Dim wdDoc As Object, wdApp As Object
Dim questiontext As String
Dim oSearchRange


On Error Resume Next
Set wdDoc = CreateObject("C:\mydoc.docx")
Set wdApp = wdDoc.Application
Set oSearchRange = wdDoc.Content

With mywb
  For i = 2 To .Range("A6000").End(xlUp).Row
    questiontext = .Range("A" & i).Value
    .Range("B" & i).Copy

    Set blabla = oSearchRange.Find.Execute.Text = questiontext
    blabla.Select

    Selection.movedown unit:=wdparagraph
    Selection.moveleft unit:=wdcharacter
    Selection.PasteAndFormat (wdFormatOriginalFormatting)

  Next i

End With
'wdDoc.Close savechanges:=True
Set wdDoc = Nothing
Set wdApp = Nothing
End Sub

---

我认为这个代码符合你的要求。在最初的帖子中，我对代码做了一些小改动，有些重要，有些不太重要。希望这些评论有助于解释我为什么这么做：

Sub UpdateWordDoc1()
    ' REQUIRES A REFERENCE TO:
    ' Microsoft Word ##.# Object Library

    Dim myws As Excel.Worksheet     ' Changed wb to ws to better abbreviate worksheet
    Dim wdDoc As Word.Document      ' No longer a generic object
    Dim wdApp As Word.Application   ' No longer a generic object
    Dim questiontext As String
    Dim oSearchRange As Word.Range  ' Word range is what will be searched
    Dim i As Long                   ' Loop through rows by count (Long)

    Set myws = ActiveWorkbook.ActiveSheet

    ' On Error Resume Next          ' Can't find bugs if they're supressed!!!
    Set wdApp = CreateObject("Word.Application")    ' Create app before opening doc
                                                    ' Need to explore what happens
                                                    ' if Word is already running
    wdApp.Visible = True            ' Make it visible so we can watch it work
    Set wdDoc = wdApp.Documents.Open("C:\mydoc.docx")   ' Open the doc

    With myws
        For i = 2 To .Range("A6000").End(xlUp).Row
            ' Word's Find function is tricky to program, because
            ' when Find succeeds, the range is moved! (Find has many
            ' other odd behaviors). Assuming you want to search the entire doc
            ' for each search term, we reset the range every time through the
            ' loop.
            Set oSearchRange = wdDoc.Content

            questiontext = .Range("A" & i).Value
            .Range("B" & i).Copy

            ' Set blabla = oSearchRange.Find.Execute.Text = questiontext
            With oSearchRange.Find
                ' Note that Word's Find settings are "sticky". For example, if
                ' you were previously searching for (say) italic text before
                ' running this Sub, Word may still search for italic, and your
                ' search could fail. To kill such bugs, explicitly set all of
                ' Word's Find parameters, not just .Text
                .Text = questiontext    ' This is what you're searching for
                If .Execute Then    ' Found it.
                                    ' NOTE: This is only gonna make a change
                                    ' at the first occurence of questiontext
                    ' When find is successful, oSearchRange will move
                    ' to the found text. But not the selection, so do Select.
                    oSearchRange.Select

                    ' Now move to where the new text is to be pasted
                    wdDoc.ActiveWindow.Selection.movedown unit:=wdparagraph
                    wdDoc.ActiveWindow.Selection.moveleft unit:=wdcharacter

                    ' While debugging, the next statement through me out of single
                    ' step mode (don't know why) but execution continued 
                    ' and the remaining words in my list we're found and text
                    ' pasted in as expected.
                    wdDoc.ActiveWindow.Selection.PasteAndFormat (wdFormatOriginalFormatting)
                End If
            End With
        Next i

    End With

    ' Clean up and close down
    wdDoc.Close savechanges:=True
    Set oSearchRange = Nothing
    Set wdDoc = Nothing
    wdApp.Quit
    Set wdApp = Nothing
    Set myws = Nothing
End Sub

---

希望有帮助

您是否添加了对Word对象库的引用？Excel不知道例如WDFormatOriginalFormat的值是什么…是的。有参考，代码运行良好。这根本没用。我的直觉是，它是围绕着选择的东西。我不认为程序正在将主动词传递给单词，并允许它控制并找到问题文本，然后采取行动。但是，显然我不确定。当我单步执行代码时，没有任何事情发生，例如，在movedown或moveleft处，我希望看到光标实际移动。code Selection.movedown和类似的东西将操纵Excel的选择，而不是Word的选择。您可以使用wdApp.Selection或wdDoc.ActiveWindow.Selection或类似工具修复此问题。谢谢您的评论。我尝试在它们前面添加wdDoc和wdApp，甚至为oSearchRange更改它们，但什么都没有发生。在find方法之后，我觉得Word光标应该移动，但是Word窗口中什么也没有发生。删除On Error Resume Next-在那里你不能真正进行任何有意义的调试。我怀疑问题行设置为blabla=oSearchRange.Find.Execute.Text=questiontext Execute返回True/False，这两个值都没有文本属性。这太棒了！非常感谢你在这方面的帮助，它工作得非常好。不过，如果文档已经打开，程序会“挂起”。如果改为这样做，我发现了一个解决方法：Set wdDoc=CreateObjectC:\mydoc.docx Set wdApp=wdDoc.Application