將數據從 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