vba 从 Excel 文档在 Word 中自动创建表格
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/3387849/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Auto creating tables in Word from an Excel document
提问by Dori
I have a set of data in Excel which is like the below (in CSV format)
我在 Excel 中有一组数据，如下所示（CSV 格式）
heading1, heading2, heading3, index
A , randomdata1, randomdata2, 1
A , randomdata1, randomdata2, 2
A , randomdata1, randomdata2, 3
B , randomdata1, randomdata2, 4
C , randomdata1, randomdata2, 5
I want to be able to auto build a word document that presents this data, which the information grouped by heading1, into separate tables. So the word document would be like
我希望能够自动构建一个 Word 文档，将这些数据（按标题 1 分组的信息）显示在单独的表格中。所以word文档会像
Table A
heading1, heading2, heading3, index
A , randomdata1, randomdata2, 1
A , randomdata1, randomdata2, 2
A , randomdata1, randomdata2, 3
Table B
heading1, heading2, heading3, index
B , randomdata1, randomdata2, 4
Table C
heading1, heading2, heading3, index
C , randomdata1, randomdata2, 5
Please could someone help me with this as it will save about 20 hours of very boring copy & pasting and formatting!
请有人帮我解决这个问题，因为它可以节省大约 20 小时非常无聊的复制粘贴和格式化！
Thanks for any help
谢谢你的帮助
回答by Doug Glancy
Dori,
多莉，
Hope this is in time to help.
希望这能及时提供帮助。
For this to work you need to set a reference to Word - in the VBA editor choose Tools>References and scroll down to Microsoft Word ##, where ## is 12.0 for Excel '07, 11.0 for Excel '03, etc. Also, the sheet shouldn't be filtered when you run this, and although you don't need to sort by heading 1, I assumed that you have.
为此，您需要设置对 Word 的引用 - 在 VBA 编辑器中选择工具>引用并向下滚动到 Microsoft Word ##，其中，## 对于 Excel '07 为 12.0，对于 Excel '03 为 11.0，等等。此外，运行此表时不应过滤该工作表，虽然您不需要按标题 1 排序，但我认为您已经这样做了。
The code assumes that your list starts with header in cell A1. IF that's not true you should make it so. It also assumes that your last column in D. You can adjust that in the line towards the end that starts with ".Copy".
该代码假定您的列表以单元格 A1 中的标题开头。如果那不是真的，你应该这样做。它还假定您在 D 中的最后一列。您可以在以“.Copy”开头的行中调整它。
Sub CopyExcelDataToWord()
Dim wsSource As Excel.Worksheet
Dim cell As Excel.Range
Dim collUniqueHeadings As Collection
Dim lngLastRow As Long
Dim i As Long
Dim appWord As Word.Application
Dim docWordTarget As Word.Document
Set wsSource = ThisWorkbook.Worksheets(1)
With wsSource
lngLastRow = .Range("A" & Rows.Count).End(xlUp).Row
Set collUniqueHeadings = New Collection
For Each cell In .Range("A2:A" & lngLastRow)
On Error Resume Next
collUniqueHeadings.Add Item:=cell.Value, Key:=cell.Value
On Error GoTo 0
Next cell
End With
Set appWord = CreateObject("Word.Application")
With appWord
.Visible = True
Set docWordTarget = .Documents.Add
.ActiveDocument.Select
End With
For i = 1 To collUniqueHeadings.Count
With wsSource
.Range("A1").AutoFilter Field:=1, Criteria1:=collUniqueHeadings(i)
.Range("A1:D" & lngLastRow).Copy
End With
With appWord.Selection
.PasteExcelTable linkedtoexcel:=False, wordformatting:=True, RTF:=False
.TypeParagraph
End With
Next i
For i = 1 To collUniqueHeadings.Count
collUniqueHeadings.Remove 1
Next i
Set docWordTarget = Nothing
Set appWord = Nothing
End Sub
