excel - 如何使用 vba 将合并表从 word 导出到 Excel

Question

我无法将合并的单词表导出到 Excel。

这是我当前未合并表的代码。

Sub ImportWordTable()
Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer 'table number in Word
Dim iRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel

wdFileName = Application.GetOpenFilename("Word files (*.docm),*.docm", , _
"Browse for file containing table to be imported")

If wdFileName = False Then Exit Sub '(user cancelled import file browser)

  Set wdDoc = GetObject(wdFileName) 'open Word file

  With wdDoc
    TableNo = wdDoc.Tables.Count
    If TableNo = 0 Then
        MsgBox "This document contains no tables", _
        vbExclamation, "Import Word Table"
    ElseIf TableNo > 1 Then
        TableNo = InputBox("This Word document contains " & TableNo & " tables." & vbCrLf & _
        "Enter table number of table to import", "Import Word Table", "1")
    End If
    With .Tables(TableNo)
        'copy cell contents from Word table cells to Excel cells
        For iRow = 1 To .Rows.Count
            For iCol = 1 To .Columns.Count
                Cells(iRow, iCol) = WorksheetFunction.Clean(.Cell(iRow, iCol).Range.Text)
            Next iCol
        Next iRow
    End With
  End With
End If
Set wdDoc = Nothing

End Sub

这不适用于合并的单元格；当我运行此脚本时，它会在找到合并单元格时出错:

Run-time error '5941': The requested member of the collection does not exist.

当我调试时，这是给出问题的行: Cells(iRow, iCol) = WorksheetFunction.Clean(.Cell(iRow, iCol).Range.Text)

如果我打开一个没有合并单元格的 word doc，它会很好地提取数据。我需要从包含合并单元格的 word doc 中提取数据。可以更改代码来做到这一点吗？

Answer 1

合并单元格的问题在于，您最终会遇到 .Columns.Count 的情况。大于行中的单元格数，因此您会收到如下错误:



这应该可以工作并处理垂直合并、水平合并或垂直和水平的合并，考虑一个字表，如:



代码可以非常简化并且不会循环遍历行/列/单元格，只需使用(记录不充分的) CommandBars.ExecuteMso 复制和粘贴表格方法:

    .Tables(TableNo).Range.Copy
    Range("A1").Activate
    Application.DisplayAlerts = False
    Application.CommandBars.ExecuteMso "PasteDestinationFormatting"
    Application.DisplayAlerts = True

这基本上是 this similar answer 的简化版本但不幸的是它不保留合并的单元格:



如果您想保留 Word 中的格式，请执行以下操作:

.Tables(TableNo).Range.Copy
Range("A1").Activate
Application.CommandBars.ExecuteMso "PasteSourceFormatting"

它应该复制格式/等:



如果您需要保留合并区域而不是 Word 格式，则只需应用 "Normal"样式到 Excel 中的结果范围:

.Tables(TableNo).Range.Copy
Range("A1").Activate
Application.CommandBars.ExecuteMso "PasteSourceFormatting"
Range("A1").CurrentRegion.Style = "Normal"