如何使用 VBA 将 Excel 中的一系列单元格粘贴到 Word 中

Question

我正在尝试在 excel 中创建一个宏，它将某个范围内的数据复制到 word 文档中，我还需要能够格式化 word 文档，但我会想一旦我弄清楚如何 select 新创建的 word 文档并将我的 selection 粘贴到其中。

到目前为止我有

'opening the word document
Dim oWord As Object
Set oWord = CreateObject(Class:="Word.Application")
oWord.Visible = True

oWord.Documents.Add 'ADD A BLANK DOCUMENT.
oWord.Activate 'ACTIVATE.

'copy info for word
Sheets("FORMAT").Select
Range("L2:L141").Select
Selection.Copy
oWord.document.Select
Selection.Paste

具体是oWord.document.select不行，我需要用什么替换才能select要粘贴到的word文档？

这是完整的代码，这实际上是我第一次编写任何代码，因此欢迎任何批评。

'for loop of copying and pasting cells from the format sheet to the message sheet.
Public Sub Message_Preview_updater()
        
    'Updates the table sheet
    Sheets("message").Select
    Range("A2:F101").Select
    Selection.Copy
    Sheets("Table").Select
    Range("A2:F101").Select
    ActiveSheet.Paste
    
    'prepares the range to paste the loop into and all the necessary variables for the loop
    Dim FillCounter As Integer
    Dim Blanks As Integer
    Sheets("FORMAT").Select
    Range("L2:L141").ClearContents
    Blanks = 0
    
    'Tests format preview cells for values and then pastes in column J skipping blank cells
    For FillCounter = 2 To 141 Step 1
        If Cells(FillCounter, 10).Value <> "" Then
            Cells((FillCounter - Blanks), 12) = Cells(FillCounter, 10).Value
        
        'tests format preview cells for blanks then adds 1 to LogBlanks
        ElseIf Cells(FillCounter, 10).Value = "" Then
            Blanks = Blanks + 1
        
        End If
    
    Next FillCounter
    
    'finally updates Message preview
    Sheets("FORMAT").Select
    Range("L2:L141").Select
    Range("L141").Activate
    Selection.Copy
    Sheets("Message").Select
    Range("I4").Select
    ActiveSheet.Paste
    '
    '================================
    '= now paste into word doc time =
    '================================
    '
    'opening the word document
    Dim oWord As Object
    Set oWord = CreateObject(Class:="Word.Application") 'INITIALIZE THE OBJECT.
    oWord.Visible = True 'OPEN THE WORD FILE.

    oWord.Documents.Add 'ADD A BLANK DOCUMENT.
    oWord.Activate 'ACTIVATE.

    'copy info for word
    Sheets("FORMAT").Select
    Range("L2:L141").Select
    'Range("L141").Activate
    Selection.Copy
    oTable.Select
    Selection.paste 

End Sub

Answer 1

复制 (Excel) 范围到新的 Word 文档

为此，您需要启用 Tools > References > Microsoft Word 16.0 Object Library（16.0 在您的 Office 版本中可能有所不同）。
通过使用此参考（又名 早期绑定 - 推荐），您将在 Excel.

Option Explicit

Sub CopyRangeToNewWord()
    On Error GoTo ClearError
    
    Const wdFolderPath As String = "C:\Test\"
    Const wdFileName As String = "Test.docx"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim ws As Worksheet: Set ws = wb.Worksheets("Format")
    Dim rg As Range: Set rg = ws.Range("L2:L141")
    
    ' Reference the Word Application.
    
    Dim wdApp As Word.Application
    Dim WordWasClosed As Boolean
    
    ' 1. Attempt to create a reference (check if it is open).
    On Error Resume Next
        Set wdApp = GetObject(, "Word.Application")
    On Error GoTo ClearError
    
    ' 2. If no reference, open and create a reference to it.
    If wdApp Is Nothing Then ' Word is closed
        Set wdApp = New Word.Application
        WordWasClosed = True
        wdApp.Visible = True ' uncomment when done testing
    'Else ' Word is open and referenced; do nothing
    End If
    
    ' Open and reference a new word document.
    Dim wdDoc As Word.Document: Set wdDoc = wdApp.Documents.Add
    
    ' Copy/Paste.
    rg.Copy
    wdDoc.Paragraphs(1).Range.PasteExcelTable _
        LinkedToExcel:=False, _
        WordFormatting:=True, _
        RTF:=False
    Application.CutCopyMode = False
    
    ' Continue modifying the Word document...
    
    
SafeExit:
    On Error Resume Next
        ' Save and close the Word document.
        If Not wdDoc Is Nothing Then ' overwrite without confirmation
            wdDoc.SaveAs2 wdFolderPath & wdFileName, wdFormatDocumentDefault
        End If
        ' Quit the Word application...
        If WordWasClosed Then ' ... if it initially was closed
            If Not wdApp Is Nothing Then wdApp.Quit
        'Else ' ... if it initially was open, don't quit; do nothing
        End If
    On Error GoTo 0
    
    Exit Sub
ClearError:
    Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
    Resume SafeExit
End Sub

如何使用 VBA 将 Excel 中的一系列单元格粘贴到 Word 中

How do I paste a range of cells from Excel into Word using VBA

excel

vba

ms-word

复制 (Excel) 范围到新的 Word 文档