VBA 在 MS Word 的特定段落中复制带有循环的 Excel 行

Question

我是一个初学者，我正在使用 vba 自动复制 MS Word 文档特定段落中的 Excel 行。我找不到可以很好地工作的 vba 代码。

有比我更有经验的人可以帮助我吗？

谢谢你。

拿督	描述
细胞1	2 号细胞
细胞3	4 号细胞

我有并且擅长如上表，总之有两个这样的段落

第1段

第2段

我想在Paragraph2中插入excel的所有行

文档单词将变成

第1段

第2段

细胞 1 细胞 2

细胞 3 细胞 4

和其他字线

Answer 1

Option Explicit

Sub Excel2Word()
    Dim ws As Worksheet
    Dim wdDoc As Object
    Dim wdApp As Object
    Dim lastRow As Long
    Dim i As Long, arrData, sTxt As String
    Const wdCollapseEnd = 0
    Const wdStory = 6
    Const DOC_FILE = "D:\TEMP\Document.docx" ' Modify as needed
    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    On Error GoTo 0
    If wdApp Is Nothing Then
        On Error Resume Next
        Set wdApp = CreateObject("Word.Application")
        On Error GoTo 0
    End If
    If wdApp Is Nothing Then
        MsgBox "Microsoft Word is not installed or accessible.", vbExclamation
        Exit Sub
    End If
    wdApp.Visible = True
    Set wdDoc = wdApp.Documents.Open(DOC_FILE)
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    arrData = ws.Range("A1:A" & lastRow).Value
    For i = 2 To lastRow
        sTxt = sTxt & vbCr & arrData(i, 1) & " " & arrData(i, 1)
    Next i
    If wdDoc.Paragraphs.Count > 1 Then
        wdDoc.Paragraphs(2).Range.InsertAfter Mid(sTxt, 2) & vbCr
    Else
        wdApp.EndKey wdStory
        wdApp.Selection.TypeText sTxt
    End If
    ' Save wdDoc and close Word App
    ' wdDoc.Close SaveChanges:=True
    ' wdApp.Quit
    MsgBox "Task completed.", vbInformation
End Sub