[VBA][基础入门]第5讲 Excel和Word的互相调用

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

[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 入职日期 = 6End EnumSub ReadWorkBook()Dim wdDoc As Word.Document '为什么这么声明，我想我以前讲过Dim wdRng As Word.RangeDim xlApp As Excel.Application '为什么这么声明，我想我以前讲过Dim xlBook As Excel.WorkbookDim xlSht As Excel.WorksheetDim xlRng As Excel.RangeDim maxRow As LongDim arrDim U& '这个你能回忆起来吗，虽然我不建议你们用Dim i&Set wdDoc = ThisDocumentOn Error GoTo getError '如果发生错误，就去到getError标签Set xlApp = GetObject(, 'Excel.Application') '获取当前打开的Excel程序，如果报错，就会去到getError标签那里GoTo NextStepgetError: Set xlApp = CreateObject('Excel.Application') '如当前没有打开的Excel程序，则新建一个 xlApp.Visible = True '调试用，调试完了，可以改成FalseNextStep: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 = xlRngxlBook.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 WithNext iApplication.ScreenUpdating = TrueEnd Sub

再看从Excel里生成Word：

Enum eIndex 工号 = 1 姓名 = 2 生日 = 3 籍贯 = 4 从业年份 = 5 入职日期 = 6End EnumSub WriteDocument()Dim wdApp As Word.ApplicationDim wdDoc As Word.DocumentDim wdRng As Word.RangeDim xlBook As WorkbookDim xlSht As WorksheetDim xlRng As Excel.RangeDim maxRow As LongDim arrDim U&Dim i&Set xlBook = ThisWorkbookSet xlSht = xlBook.Worksheets('资料')maxRow = xlSht.Range('A' & xlSht.Rows.Count).End(xlUp).RowSet xlRng = xlSht.Range('A2:F' & maxRow)arr = xlRngU = UBound(arr, 1)On Error GoTo getErrorSet wdApp = GetObject(, 'Word.Application') '当前如有Word程序，直接调用GoTo NextStepgetError: Set wdApp = CreateObject('Word.Application') '如没有，则新建NextStep: wdApp.ScreenUpdating = FalseFor 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 WithNext iEnd Sub

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