从word复制粘贴表格到excel

Question

我有一个定期更新的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 

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

Answer 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