如何使用VBA将合并表从Word导出到Excel

时间:2018-06-21 12:53:25

标签: excel vba ms-word word-vba

我无法将合并的单词表导出到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

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

  

运行时错误'5941':所请求的集合成员没有   存在。

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

如果我在不合并单元格的情况下打开word doc,它会很好地提取数据。我需要从合并单元格的Word文档中提取数据。可以更改代码来做到这一点吗?

1 个答案:

答案 0 :(得分:1)

合并单元格的问题是,您最终会遇到.Columns.Count超过行中单元格数量的情况,因此会出现类似以下错误:

enter image description here

这应该可以工作并处理垂直合并,水平合并或垂直合并和水平合并,请考虑以下单词表:

enter image description here

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

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

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

enter image description here

如果要保留Word的格式,请执行以下操作:

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

它应该复制格式/等:

enter image description here

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

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

enter image description here