将 Word 文件 table 复制到 Excel 文件（合并单元格和多行单元格）

Question

在另一个 post 中，我终于从 Word 文件中选择了一个 table 并将其保存到 Excel 文件中。我在 Word VBA 中有以下代码：

    Dim wrdTbl As Table
    Dim RowCount As Long, ColCount As Long, i As Long, j As Long

    'Excel Objects
    Dim oXLApp As Object, oXLwb As Object, oXLws As Object

    'Set your table
    Set wrdTbl = ActiveDocument.Tables(InputBox("Table # to copy? There are " & ActiveDocument.Tables.Count & " tables to choose from."))

    'If ActiveDocument.Tables.Count = 0 Then MsgBox "There are no tables in word document"
        'Exit Sub

    'Get the word table Row and Column counts
    ColCount = wrdTbl.Columns.Count
    RowCount = wrdTbl.Rows.Count

    'Create a new Excel Application
    Set oXLApp = CreateObject("Excel.Application")

    'Hide Excel
    oXLApp.Visible = False

    'Open the relevant Excel file
    Set oXLwb = oXLApp.Workbooks.Open("C:\Users\" & Environ("Username") & "\Desktop\ExcelEx.xlsx")
    'Work with Sheet1. Change as applicable
    Set oXLws = oXLwb.Sheets(1)

    'Loop through each row of the table
    For i = 1 To RowCount
        'Loop through each cell of the row
        For j = 1 To ColCount
        'This gives you the cell contents
            wrdTbl.Cell(i, j).Range.Copy

            With oXLws
                .Range("A1").Activate
                .Cells(i, j).Select
                .PasteSpecial (wdPasteText)
                .Range("A1").CurrentRegion.Style = "Normal"
            End With

        Next
    Next

    'Close and save Excel file
    oXLwb.Close savechanges:=True

    'Cleanup (VERY IMPORTANT)
    Set oXLws = Nothing
    Set oXLwb = Nothing
    oXLApp.Quit
    Set oXLApp = Nothing

    MsgBox "Done"

End Sub

我的问题是，如果我有一个带有合并单元格的 table，它会抛出错误：“5941”请求的集合成员在行中不存在：

wrdTbl.Cell(i, j).Range.Copy

我怎样才能获得复制合并单元格的代码？

另一个问题是当我有一个包含多行的单元格时，因为在 Excel 文件中它将这些单元格行复制到 Excel 中的不同单元格中。我该如何解决这个问题？非常感谢您的回答！

Answer 1

您需要逐个遍历单元格，而不是按行和列。例如：

Dim wrdTbl As Table, c As Long
'Excel Objects
Dim oXLApp As Object, oXLwb As Object, oXLws As Object

'Set your table
With ActiveDocument
    If ActiveDocument.Tables.Count = 0 Then MsgBox "There are no tables in word document"
        Exit Sub
    Else
        Set wrdTbl = .Tables(InputBox("Table # to copy? There are " & .Tables.Count & " tables to choose from."))
    End If
End With

'Create a new Excel Application
Set oXLApp = CreateObject("Excel.Application")
With oXLApp
'Hide Excel
    .Visible = False

    'Open the relevant Excel file
    Set oXLwb = oXLApp.Workbooks.Open("C:\Users\" & Environ("Username") & "\Desktop\ExcelEx.xlsx")
End With

'Loop through each row of the table
With wrdTbl.Range
    For c = 1 To .Cells.Count
        With .Cells(c)            
          'Work with Sheet1. Change as applicable
          oXLwb.Sheets(1).Cells(.RowIndex, .ColumnIndex).Value = Split(.Range.Text, vbCr)(0)
        End With
    Next
End With

'Close and save Excel file
oXLwb.Close True

'Cleanup (VERY IMPORTANT)
oXLApp.Quit
Set oXLwb = Nothing: Set oXLApp = Nothing

MsgBox "Done"

如果要在 Excel 中复制单词 table，请替换：

'Loop through each row of the table
With wrdTbl.Range
    For c = 1 To .Cells.Count
        With .Cells(c)
          'Work with Sheet1. Change as applicable
          oXLwb.Sheets(1).Cells(.RowIndex, .ColumnIndex).Value = Split(.Range.Text, vbCr)(0)
        End With
    Next
End With

与：

wrdTbl.Range.Copy
With oXLwb.Sheets(1)
.Paste .Range("A1")
End With

将 Word 文件 table 复制到 Excel 文件（合并单元格和多行单元格）

Copy Word file table to Excel file (merged cells and multiple-line cells)

excel

vba

ms-word

copy-paste

word-table