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

Question

您好，我正在尝试使用此代码将数据从excel导出到预先存在的单词表中。但是，一旦代码到达wdDoc.Tables中的每个wdCell循环，运行时错误'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

我已经在你的代码校正观察以下几点。

你设置你的文件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 

Thse两行需要改为： -

ReDim vaData(1 To 10, 1 To 7) 

For j = 1 To 7 

其他点，以确保有： -

1. 您已设置引用到Microsoft Word对象库 对应于您的Excel版本。我有Excel 2016，因此我有 设置对Microsoft Word 16.0对象库的引用。
2. 您的Word文件应该存在于您存储您的ThisWorkbook宏文件的 所在的目录中。我在 Excel Macro文件中使用宏，而不是在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文档中获得的结果。