您好我使用以下代码将Excel工作表中的值复制到word中的预定义表中。以下适用于1列,如何让它传输所有5列的数据?感谢
Sub ExportData()
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdCell As Word.Cell
Dim i As Long
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim rnData As Range
Dim vaData As Variant
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets("Sheet1")
With wsSheet
Set rnData = .Range("A1:E10")
End With
'Add the values in the range to a one-dimensional variant-array.
vaData = rnData.Value
'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(ThisWorkbook.Path & "\Test.doc")
'Import data to the first table and in the first column of a table in Microsoft Word.
For Each wdCell In wdDoc.Tables(1).Columns(1).Cells
i = i + 1
wdCell.Range.Text = vaData(i, 1)
Next wdCell
'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 transfered to Test.doc, vbInformation"
End Sub
答案 0 :(得分:1)
所以这是一个迟到的答案,但请尝试以下方法:
添加到声明
Dim j As Long
从声明中删除
Dim rnData As Range
更改强>
With wsSheet
Set rnData = .Range("A1:E10")
End With
'Add the values in the range to a one-dimensional variant-array.
vaData = rnData.Value
以强>
ReDim vaData(1 To 10, 1 To 5)
With wsSheet
vaData = .Range("A1:E10")
End With
并更改
'Import data to the first table and in the first column of a table in Microsoft Word.
For Each wdCell In wdDoc.Tables(1).Columns(1).Cells
i = i + 1
wdCell.Range.Text = vaData(i, 1)
Next wdCell
以强>
For j = 1 To 5
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
更正
MsgBox "The data has been transferred to Test.doc", vbInformation