将数据从 Excel 传输到预先存在的 Word 表格

Question

我正在尝试将数据从 Excel 导出到预先存在的 Word 表。

一旦代码到达For Each wdCell In wdDoc.Tables循环，我就会收到运行时错误

'91' 对象变量或 With 块变量未设置出现。

有没有办法让这个代码将数据传输到 7 列？

Sub ExportDataWordTable()

Const stWordDocument As String = "C:\Users\jfournier\Desktop\VBA Macro Files\TESTQUOTE.docm"

Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdCell As Word.Cell
Dim i As Long
Dim j As Long
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim vaData As Variant

Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets("Sheet2")

ReDim vaData(1 To 10, 1 To 5)

With wsSheet
    vaData = .Range("B3:H20")
End With

'Here we instantiate the new object.
Set wdApp = New Word.Application

'Here the target document resides in the same folder as the workbook.
Set wdDoc = wdApp.Documents.Open(wbBook.Path & "\" & stWordDocument)

'Import data to the first table and in the first column of a table in Microsoft Word.
For j = 1 To 5
    i = 0

    For Each wdCell In wdDoc.Tables(2).Columns(j).Cells
        i = i + 1
        wdCell.Range.Text = vaData(i, j)
    Next wdCell

Next j

'Save and close the document.
With wdDoc
    .Save
    .Close
End With

'Close the hidden instance of Microsoft Word.
wdApp.Quit

'Release the external variables from the memory
Set wdDoc = Nothing
Set wdApp = Nothing
MsgBox "The data has been transferred to Test.doc", vbInformation

End Sub

Answer 1

这是一种不同的方法供您尝试：

Sub ExportDataWordTable()
Dim wdApp As New Word.Application, wdDoc As Word.Document
Const stWordDocument As String = "\TESTQUOTE.docm"
Dim xlWkBk As Workbook, xlWkSht As Worksheet
Set xlWkBk = ThisWorkbook: Set xlWkSht = xlWkBk.Worksheets("Sheet2")

'Here the target document resides in the same folder as the workbook.
Set wdDoc = wdApp.Documents.Open(Filename:=xlWkBk.Path & stWordDocument, AddToRecentFiles:=False)

'Copy the used range
With xlWkSht
  .Range("B3:H" & .UsedRange.SpecialCells(xlCellTypeLastCell).Row).Copy
End With

With wdDoc
  'Paste the copied content to the end of the table
  .Tables(2).Range.Characters.Last.PasteAppendTable

  'Save and close the document.
  .Close True
End With

'Close our instance of Microsoft Word.
wdApp.Quit

'Clear the clipboard
Application.CutCopyMode = False

'Release the external variables from the memory
Set wdDoc = Nothing: Set wdApp = Nothing: Set xlWkSht = Nothing: Set xlWkBk = Nothing

MsgBox "The data has been transferred to Test.doc", vbInformation
End Sub

注意：由于要复制的行数不同，上面的代码假定 usedrange 决定了要复制的行数。 使用这种方法，您的 Word 表格只需要有标题行。

Answer 2

我在您的代码中观察到以下几点以进行更正。

您正在设置文件 TESTQUOTE.docm 的完整路径

Const stWordDocument As String = "C:\Users\jfournier\Desktop\VBA Macro Files\TESTQUOTE.docm"

稍后您正在设置目标文档与工作簿位于同一文件夹中的路径。

Set wdDoc = wdApp.Documents.Open(wbBook.Path & "\" & stWordDocument)

这将导致路径字符串发生冲突。 你应该只提到。

Const stWordDocument As String = "TESTQUOTE.docm"

您希望代码将数据传输到 7 列。 您已将范围设为B3:H20但您仅将变体vaData设置为 5 列。

 ReDim vaData(1 To 10, 1 To 5)

此外，您仅循环 5 列。

'Import data to the first table and in the first column of a table in Microsoft Word.
For j = 1 To 5

这两行需要更改为：-

ReDim vaData(1 To 10, 1 To 7)

For j = 1 To 7

其他要确保的要点是：-

1. 您已根据您的 Excel 版本设置了对 Microsoft Word 对象库的引用。 我有 Excel 2016，所以我设置了对 Microsoft Word 16.0 对象库的引用。
2. 您的 Word 文件应该预先存在于您存储 ThisWorkbook 宏文件的同一目录中。 我在 Excel 宏文件中使用过宏，而不是在 Word VBA 编辑器中使用过。
3. 您的 TESTQUOTE word 文档应具有正确的表结构 对应于范围 B3:H20，即 18 行 7 列。 当您从 Excel 文件运行 VBA 程序时，它应该处于关闭状态。

最后你更正的代码如下。

 Sub ExportDataWordTable()

    Const stWordDocument As String = "TESTQUOTE.docm"

    Dim wdApp As Word.Application
    Dim wdDoc As Word.Document
    Dim wdCell As Word.Cell
    Dim i As Long
    Dim j As Long
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
    Dim vaData As Variant

    Set wbBook = ThisWorkbook
    Set wsSheet = wbBook.Worksheets("Sheet2")

    ReDim vaData(1 To 10, 1 To 7)

    With wsSheet
        vaData = .Range("B3:H20")
    End With

    'Here we instantiate the new object.
    Set wdApp = New Word.Application

    'Here the target document resides in the same folder as the workbook.
    Set wdDoc = wdApp.Documents.Open(wbBook.Path & "\" & stWordDocument)

    'Import data to the first table and in the first column of a table in Microsoft Word.
    For j = 1 To 7
    i = 0

    For Each wdCell In wdDoc.Tables(1).Columns(j).Cells
        i = i + 1
        wdCell.Range.Text = vaData(i, j)
        Next wdCell

    Next j

    'Save and close the document.
    With wdDoc
    .Save
    .Close
    End With

    'Close the hidden instance of Microsoft Word.
    wdApp.Quit

    'Release the external variables from the memory
    Set wdDoc = Nothing
    Set wdApp = Nothing
    MsgBox "The data has been transferred to TESTQUOTE.docm", vbInformation

End Sub

我已经在示例数据上测试了这个程序，我正在附加 Excel 示例数据的快照以及在 Word 文档上获得的结果。

Answer 3

[已解决]

Err 4605 – “此方法或属性不可用，因为剪贴板为空或无效”

ErrResume:
    DoEvents
    Range("B3:H99").Copy

    On Error GoTo ErrPaste
        wdDoc.Tables(2).Range.Characters.Last.PasteAppendTable
        Application.CutCopyMode = False
    On Error GoTo 0

ErrPaste:
  'Clipboard is empty or not valid.
    If Err.Number = 4605 Then
        DoEvents
        Resume ErrResume
    End If