将表格从word复制粘贴到excel答案

【问题标题】：copy-paste tables from word to excel将表格从word复制粘贴到excel
【发布时间】：2014-02-24 21:10:57
【问题描述】：

我有一个定期更新的 word 文档。我可以进入该 Word 文档，选择整个表格的内容并复制，然后进入 Excel 电子表格并粘贴。搞砸了；但是，我将其修复如下：

    sht.Cells.UnMerge
    sht.Cells.ColumnWidth = 14
    sht.Cells.RowHeight = 14
    sht.Cells.Font.Size = 10

无论表是否具有合并字段，此手动复制粘贴都有效。然后我可以开始手动操作它：解析、检查、计算等。

我可以一次做一张桌子，但这很乏味，当然容易出错。

我想自动化这个。我找到了一些代码：

Sub read_word_document()

Dim sht As Worksheet

Dim WordDoc As Word.Document
Dim WordApp As Word.Application

Set WordApp = CreateObject("Word.Application")
WordApp.Visible = False

On Error GoTo ErrHandler

Set WordDoc = WordApp.Documents.Open("Z:\mydir\myfile1.DOC", ReadOnly:=True)


j = 0
For i = 1 To WordDoc.Tables.Count
    DoEvents
    Dim s As String
    s = WordDoc.Tables(i).Cell(1, 1).Range.Text
        Debug.Print i, s
        WordDoc.Tables(i).
        Set sht = Sheets("temp")
        'sht.Cells.Clear
        sht.Cells(1, 1).Select
        sht.PasteSpecial (xlPasteAll)

    End If
Next i

WordDoc.Close
WordApp.Quit

GoTo done

ErrClose:
  On Error Resume Next

ErrHandler:

Debug.Print Err.Description

On Error GoTo 0

done:

End Sub

当然，这只会一次又一次地覆盖同一张纸——这没关系。这只是一个测试。问题是这将适用于那些没有合并单元格的表格。但是，如果表格已合并单元格，则会失败。我无法控制我得到的文件。它包含近一百个表。有没有办法像我手动执行操作时那样复制粘贴？

【问题讨论】：

标签： excel vba ms-word copy-paste

【解决方案1】：

类似这样的：

Sub read_word_document()

Const DOC_PATH As String = "Z:\mydir\myfile1.DOC"

Dim sht As Worksheet
Dim WordDoc As Word.Document
Dim WordApp As Word.Application
Dim i As Long, r As Long, c As Long
Dim rng As Range, t As Word.Table

    Set WordApp = CreateObject("Word.Application")
    WordApp.Visible = False
    Set WordDoc = WordApp.Documents.Open(DOC_PATH, ReadOnly:=True)

    Set sht = Sheets("Temp")
    Set rng = sht.Range("A1")
    sht.Activate

    For Each t In WordDoc.Tables
        t.Range.Copy
        rng.Select
        rng.Parent.PasteSpecial Format:="Text", Link:=False, _
                    DisplayAsIcon:=False
        With rng.Resize(t.Rows.Count, t.Columns.Count)
            .Cells.UnMerge
            .Cells.ColumnWidth = 14
            .Cells.RowHeight = 14
            .Cells.Font.Size = 10
        End With

        Set rng = rng.Offset(t.Rows.Count + 2, 0)
    Next t
    WordDoc.Close
    WordApp.Quit
End Sub

【讨论】：