将表格从word复制粘贴到excel [英] copy-paste tables from word to excel
问题描述
我有一个定期更新的 Word 文档.我可以进入那个 Word 文档,选择整个表格的内容并复制,然后进入 Excel 电子表格并粘贴它.搞砸了;但是,我按如下方式修复它:
I have a word document which is updated periodically. I can go into that Word document, select the contents of an entire table and copy, then go into an Excel spreadsheet and paste it. It's screwed up; however, I fix it as follows:
sht.Cells.UnMerge
sht.Cells.ColumnWidth = 14
sht.Cells.RowHeight = 14
sht.Cells.Font.Size = 10
无论表格是否已合并字段,此手动复制粘贴都有效.然后我可以开始手动操作它:解析、检查、计算等.
This manual copy-paste works regardless of whether the table is has merged fields. Then I can start to manipulate it manually: parsing, checking, computations, etc.
我可以一次完成一张桌子,但它很乏味,当然容易出错.
I can do this one table at a time, but it's tedious and of course error prone.
我想自动化这个.我找到了一些代码:
I want to automate this. I found some code:
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:mydirmyfile1.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
当然,这只会一次又一次地覆盖同一张纸 - 没关系.这只是一个测试.问题是这适用于那些没有合并单元格的表.但是,如果表格已合并单元格,则失败.我无法控制我得到的文件.它包含近百张桌子.有没有办法像我手动执行操作时所做的那样复制粘贴?
Of course this would just overwrite the same sheet again and again - and that's okay. This is just a test. The problem is this will work for those tables that do not have merged cells. However, it fails if the table has merged cells. I have no control over the file I get. It contains almost a hundred tables. Is there a way to do the copy paste the EXACT WAY that I do when I perform the operation manually?
推荐答案
是这样的:
Sub read_word_document()
Const DOC_PATH As String = "Z:mydirmyfile1.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
这篇关于将表格从word复制粘贴到excel的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!