vba 将excel 表复制到word（VBA基础入门）

截止目前写了这些课程了：

[VBA][基础入门] 第1讲 常量和变量

[VBA][基础入门] 第2讲 录制宏

[VBA][基础入门] 第3讲 认识VBA IDE（集成开发环境）

[VBA][基础入门] 第4讲 对象模型

不知道大家是不是按照我的讲课顺序在认真看和学。

上面只有两个有链接，是因为不敢违反头条的链接使用规则。

下面接着上一节的讲，尽量紧扣上一节的内容，正确这一节课来个醍醐灌顶。

一、先教你们怎么看内置对象模型

先尝试看Ｗord的：

这里需要用到，也会是你们以后使用VBA常用的部分

Alt F11，F1，F2

对于初学者，看对象模型的起点是从Application开始看，先把Application当做顶级对象。

先在F1里输入：Application 对象

里面Application对象下的所有成员分成了三类：

方法、属性、事件

先过一下，大概了解有哪些成员，对于一眼看去就特别实用，或者你比较感兴趣的方法，就点进去看一眼再返回来。重点是能尽快建立对象树。

如下是我现整理出来的Documents下的对象树，包含大部分内容，加粗标注为很常用的对象。

Application

----Documents

--------Range

--------Shapes

--------Bookmarks

--------Characters

--------Comments

--------ContentControls

--------Endnotes

--------Fields

--------Footnotes

--------FormFields

--------Frames

--------Hyperlinks

--------Indexes

--------Inlineshapes

--------Lists

--------OMaths

--------Paragraphs

--------Revisions

--------Sections

--------Sentences

--------Shapes

--------StoryRanges

--------Styles

--------Subdocuments

--------Tables

--------TableOfContents

--------Variables

--------Windows

--------Words

我认为所有这些对象里，吃透Range对象，就能玩转WordVBA。

下节课再讲Word.Range对象

二、然后再教怎么在不同程序间交互

两个文件分别是模板.doc、资料.xlsm

在Word里读取Excel：

Enum eIndex 工号 = 1 姓名 = 2 生日 = 3 籍贯 = 4 从业年份 = 5 入职日期 = 6 End Enum Sub ReadWorkBook() Dim wdDoc As Word.Document '为什么这么声明，我想我以前讲过 Dim wdRng As Word.Range Dim xlApp As Excel.Application '为什么这么声明，我想我以前讲过 Dim xlBook As Excel.Workbook Dim xlSht As Excel.Worksheet Dim xlRng As Excel.Range Dim maxRow As Long Dim arr Dim U& '这个你能回忆起来吗，虽然我不建议你们用 Dim i& Set wdDoc = ThisDocument On Error GoTo getError '如果发生错误，就去到getError标签 Set xlApp = GetObject(, "Excel.Application") '获取当前打开的Excel程序，如果报错，就会去到getError标签那里 GoTo NextStep getError: Set xlApp = CreateObject("Excel.Application") '如当前没有打开的Excel程序，则新建一个 xlApp.Visible = True '调试用，调试完了，可以改成False NextStep: On Error Goto 0 '不处理其他错误 Set xlBook = xlApp.Workbooks.Open(wdDoc.Path & "\资料.xlsm", , True) '打开工作簿 Set xlSht = xlBook.Worksheets("资料") '获取工作表 maxRow = xlSht.Range("A" & xlSht.Rows.Count).End(xlUp).Row '获取最后的非空列号，相当于在A1048576，按Ctrl ↑ Set xlRng = xlSht.Range("A2:F" & maxRow) '获取目标区域 arr = xlRng xlBook.Close False 'Excel的任务完成了，关闭且不保存 U = UBound(arr, 1) Application.ScreenUpdating = False '关闭当前Word程序屏幕刷新，极大提供效率 For i = 1 To U '循环，写数据到Word的表格1中 With wdDoc.Tables(1) Set wdRng = .Cell(1, 1).Range wdRng.SetRange wdRng.End - 4, wdRng.End - 1 wdRng.Text = arr(i, eIndex.工号) .Cell(2, 2).Range.Text = arr(i, eIndex.姓名) .Cell(3, 2).Range.Text = arr(i, eIndex.生日) .Cell(3, 4).Range.Text = arr(i, eIndex.籍贯) .Cell(4, 2).Range.Text = arr(i, eIndex.从业年份) .Cell(4, 4).Range.Text = arr(i, eIndex.入职日期) If Application.Version >= 14 Then 'Word2010及以上 .Parent.SaveAs2 wdDoc.Path & "\" & arr(i, 工号) & "_" & arr(i, 姓名) & ".doc" Else .Parent.SaveAs wdDoc.Path & "\" & arr(i, 工号) & "_" & arr(i, 姓名) & ".doc" End If End With Next i Application.ScreenUpdating = True End Sub

再看从Excel里生成Word：

Enum eIndex 工号 = 1 姓名 = 2 生日 = 3 籍贯 = 4 从业年份 = 5 入职日期 = 6 End Enum Sub WriteDocument() Dim wdApp As Word.Application Dim wdDoc As Word.Document Dim wdRng As Word.Range Dim xlBook As Workbook Dim xlSht As Worksheet Dim xlRng As Excel.Range Dim maxRow As Long Dim arr Dim U& Dim i& Set xlBook = ThisWorkbook Set xlSht = xlBook.Worksheets("资料") maxRow = xlSht.Range("A" & xlSht.Rows.Count).End(xlUp).Row Set xlRng = xlSht.Range("A2:F" & maxRow) arr = xlRng U = UBound(arr, 1) On Error GoTo getError Set wdApp = GetObject(, "Word.Application") '当前如有Word程序，直接调用 GoTo NextStep getError: Set wdApp = CreateObject("Word.Application") '如没有，则新建 NextStep: wdApp.ScreenUpdating = False For i = 1 To U With wdApp.Documents.Open(xlBook.Path & "\模板.doc") '打开Word模板 With .Tables(1) '往word文档的表格1里写数据 Set wdRng = .Cell(1, 1).Range wdRng.SetRange wdRng.End - 4, wdRng.End - 1 wdRng.Text = arr(i, eIndex.工号) .Cell(2, 2).Range.Text = arr(i, eIndex.姓名) .Cell(3, 2).Range.Text = arr(i, eIndex.生日) .Cell(3, 4).Range.Text = arr(i, eIndex.籍贯) .Cell(4, 2).Range.Text = arr(i, eIndex.从业年份) .Cell(4, 4).Range.Text = arr(i, eIndex.入职日期) End With If wdApp.Version >= 14 Then 'Word2010及以上 .SaveAs2 xlBook.Path & "\" & arr(i, 工号) & "_" & arr(i, 姓名) & ".doc" Else .SaveAs xlBook.Path & "\" & arr(i, 工号) & "_" & arr(i, 姓名) & ".doc" End If .Close True End With Next i End Sub

请大家好好分析一下这两段代码，力求全部吃透。

不能吃透的内容本文评论下留言，我会以天为单位统一回复。

,