從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