用Excel VBA控制 Word

Excel VBA 操作 Word（入门篇）

本文的对象是：有一定Excel VBA基础，对Word VBA还没有什么认识，通过VBA操作Word还有困难的人。

一、新建Word引用

需要首先创建一个对 Word Application 对象的引用。在VBA中，工具-引用，选取“MicroSoft Word 11.0 Object

Library”。

方法一、New ation

Dim Wordapp As ation

Set Wordapp = New ation

e = True '可见

'Updating = False '屏幕刷新

Dim WordD As nt '定义word类

Set WordD = '新建文档

‘Set WordD = (filename) '打开文档

……

'关闭文档

Set WordD = Nothing

'退出Word对象

方法二、CreateObject

Dim WordApp As Object

Set WordApp = CreateObject("ation") '新建Word对象

Dim WordD As Object

‘后续操作及退出一样……

使用方法一定义，后续程序设计时，各对象、方法有逐步提示，但需先在“工具-引用”中勾选相关“MicroSoft Word

**** Object Library”

使用方法二定义则相反，不需要勾选，但也没有逐步提示。

方法三、GetObject

文件已打开的情况下，使用：Set WordD=GetObject(filename)，可建立对文档的引用，如果文件没有打开，则还需要

先用方法一或二来操作。

方法一和方法二的区别：

方法一：前期绑定，好处是在对象后输入句点可以给出快速提示。因为需要先引用对象，所以容易出现版本兼容问题。

方法二：后期绑定，没有提示，根据运行代码机器上对象的版本创建对象，兼容性好。

有时二者有较大区别，可论坛搜索字典对象。建议编写代码时使用前期绑定，发布时使用后期绑定。

二、认识Word的结构

Excel有：

ation ’Excel对象

ation. Workbooks ’工作簿

ation. ’工作表

工作表下是Range，区域；Cells(row,col)，单元格

Word有:

ation

nts ’文档

文档下有字符、单词、句子、段落和节。字符组成单词，单词组成句子，句子组成段落。此外，每个文档具有一个包

含一个或多个节的 Sections 集合，每一个节都有一个包含该节页眉和页脚的 HeadersFooters 集合。

Characters(index)

Words(index)

Sentences(index)

Paragraphs(index)

Sections(index) ‘节

Content

前三个和最后一个返回Range对象，能直接使用任何区域属性或方法修改该 Range 对象。Paragraphs和Sections返

回该集合的单个成员，而不是 Range 对象，不能直接使用区域属性或方法。如下使用例子：Words(1)后面直接.Copy，而

Paragraphs(1)和.Copy之间多了一个.Range。

(1).Copy

aphs(1).

Characters：字符。ces(1).，第一句的字符总数。

Words：单词，对于英文来说是二个空格之间的字母加空格，对于中文，一个标点符号，一个汉字，或一个词（按照微

软的输入法中的词组定义？）算一个Words。（感觉不是很可靠？）

Sentences：句子，以句号结束？感觉也不是一个很可靠的范围，感觉还是字符、段落、节，控制起来靠谱一些。

Content：主文档文字部分，所有的文字。

Set myRange = t

= "Arial"

= 10

Range 对象表示文档中的一个连续范围，由一个起始字符位置和一个终止字符位置定义。这个连续范围可以小到一个

插入点，大到整个文档。

Dim rngPa As Range

Set rngPa = ActiveDocument. Characters (1) ‘第一个字符

Set rngPa = ( _

Start:=aphs(1)., _

End:=aphs(4).) ‘第1段头到第4段尾

Set rngPa = (Start:=0, End:=10) ‘当前文档前10个字符

选定，我觉得用处不大，原因就是为什么要选中呢？能操作就直接操作，不能的话，就选中吧（他可以说是没办法的

办法）。

range对象的赋值：(包括任意的对象，Set是对对象赋值的标准语句)

set a=b

和变量的赋值：a=1不一样

三、通过录制宏生成代码

有了对Word基本结构的认识，想操作这些对象应该使用什么方法、修改哪些属性？不知道就“录制宏”。录制宏是我

们认识未知对象的很好方法之一，通过宏录制器将操作译成Word的 Visual Basic 代码，再根据需要修改代码。Word中录

制与Excel不同的是，不能使用鼠标移动光标或选中一行，只能使用键盘来移动，或用Shift+方向键来选中。以下几句话

就是键盘的：上、下、左、右、Home、End、Shift+左选中5个字符、Shift+右选中5个字符。

Unit:=wdLine, Count:=1

wn Unit:=wdLine, Count:=1

ft Unit:=wdCharacter, Count:=1

ght Unit:=wdCharacter, Count:=1

y Unit:=wdLine ‘wdLine,wdParagraph,,wdstory:行，段落，文档

Unit:=wdLine

ft Unit:=wdCharacter, Count:=5, Extend:=wdExtend

ght Unit:=wdCharacter, Count:=5, Extend:=wdExtend

录制的宏使用 Selection 属性返回 Selection 对象。即：录制的宏总是以Selection.开头的，如上。要想使用这个

Selection.，有时候我们就不得不先对特定的对象.Select，选中。

当然，Selection是一个Range，Characters、Words、Sentences也是Range，Paragraphs(n). Range, Sections(2).

Range也是Range，那我们就可以将Selection.后面的语句嫁接到前面这些Range之后，就不用先.Select了。

或者光标在你所需要的位置，也不需要事先.Select，也可直接使用：ion

录制的宏，通过嫁接或者复制到EXCEL VBA之后，有的运行会出错，此时应检查以下几项：

1、第一项中要求的“引用”建立了没？

2、利用VBA提醒功能检查语句。VBA编辑过程中，通常在打下. 之后（需要前期绑定？），该对象所有的方法、属性

都会显示出来，利用这个特点，可以检查录制的宏，能否嫁接到需要操作的对象之后。提示里有就能，没有就不能。

3、部分转换函数，Word VBA里有，Excel VBA里可能没有，遇到这样的情况，也可能出错。

例：

aphs(1).ineIndent = CentimetersToPoints(0.35)

ineIndent = CentimetersToPoints(0.35)是“首行缩进2字符”操作录制的，嫁

接后，运行出错，按方法2检查：.ineIndent能用在Range之后，那么就是

CentimetersToPoints(0.35)出问题了？这显然是一个函数，字面意思是“厘米转换成点数”，（录制时我明明输入的是“2

字符”，录下来咋成了厘米为单位呢？）那是否是Excel VBA里没有这个函数呢？，将=后面直接改为数字运行通过，最后试

下来=20大约相当于5号字的“首行缩进2字符”。

aphs(1). = "仿宋_GB2312" '字体

aphs(1). = 16 '三号字

aphs(1).ineIndent = 32 '三号字大小为16，首先缩进2字符

就是32，也还比较好算。

'设置页眉页脚

'If pecial <> wdPaneNone Then (2).Close

'If = wdNormalView Or

= wdOutlineView Then =

wdPrintView

'ew = wdSeekCurrentPageHeader '设置页眉

ew = wdSeekCurrentPageFooter '设置页脚

Previous = Not Previous

'切换页眉页脚“与上一节相同”，但为何一切换，光标就到上一页页脚？

ew = wdSeekMainDocument '切换回主文档

' Unit:=wdStory '跳至文档最后

ew = wdSeekCurrentPageFooter '设置页脚

'If er = True Then '切换页眉页脚

'ew = wdSeekCurrentPageFooter

'Else

'ew = wdSeekCurrentPageHeader

'End If

'wn Unit:=wdLine, Count:=2 '

tory '全选

xt Text:="时间： 评语： 日期:"

ragraph '增加一段

xt Text:="成绩： 评价：☆☆☆☆☆"

ew = wdSeekMainDocument '切换回主文档

下面的代码的功能是，全选word文档的当前页，注意，是当前页，即插入条所在的页，而不是全文。

Dim CurrentPageStart As Long, CurrentPageEnd As Long, myRange As Range

Dim Currentpage As Integer, Pages As Integer

On Error Resume Next

Currentpage = ation(wdActiveEndPageNumber)

Pages = ation(wdNumberOfPagesInDocument)

CurrentPageStart = (what:=wdGoToPage, Which:=wdGoToNext, Name:=Currentpage).start

If Currentpage = Pages Then

CurrentPageEnd =

Else

CurrentPageEnd = (what:=wdGoToPage, Which:=wdGoToNext, Name:=Currentpage + 1).start

End If

Set myRange = (CurrentPageStart, CurrentPageEnd)

word中编写VBA代码,我想运行宏后弹出inputbox对话框,输入任意数字(比如3),确定后第三页就变成当前页了?

MyPageindex = InputBox("请输入页码：", "页码跳转")

What:=wdGoToPage, Which:=wdGoToAbsolute,Name:=MyPageindex

四、Word vba常用语句100句

1、系统参数

(01) Printer ‘获取当前打印机

(02) '当前应用程序文档的高度

(03) ‘当前应用程序文档的宽度

(04) ‘获取Word版本号和编译序号

(05) n ‘当前应用程序名

(06)

(07)

(08)

(09)

(10)

(11)

(12)

(13)

(14)

(15)

(16)

(17)

(18)

(19)

(20)

(21)

(22)

(23)

(24)

(25)

2、Documents/Document对象

(26) me '返回当前文档采用的模板名及模板所在位置

(27) '返回当前文档中的书签数

(28) '返回当前文档的字符数

(29) me ‘返回当前文档的代码名称

(30) ‘ 返回当前文档中的评论数

(31) '返回当前文档中的尾注数

(32) '返回当前文档中的域数目

(33) ‘返回当前文档中的脚注数

(34) me '返回当前文档的全名及所在位置

(35) sword '当前文档是否有密码保护

(36) '返回当前文档中的链接数

(37) '返回当前文档中的索引数

(38) '返回当前文档中项目编号或项目符号数

(39) '返回当前文档中使用的列表模板数

(40) '返回当前文档中的段落数

(41) rd=XXX '设置打开文件使用的密码

(42) ly '获取当前文档是否为只读属性

(43) '当前文档是否被保存

(44) '当前文档中的节数

(45) ‘当前文档中的语句数

(46) '当前文档中的形状数 ,图形？

(47) '当前文档中的样式数

(48) ‘当前文档中的表格数

(49) ‘返回当前文档中的引文目录数

(50) ‘返回当前文档中引文目录类别数

(51) ‘返回当前文档中的目录数

(52) '返回当前文档中的图表目录数

3、Paragraphs/Paragraph对象

(53) '返回所选区域的段落数

(54) '返回所选区域中的第一段

(55) aphs(1).LeftIndent '返回当前文档中第一段的左缩进值

(56) aphs(1).LineSpacing '返回当前文档中第一段的行距

(57) aphs(1).OutlineLevel ‘返回或设置当前文档中第一段的大纲级别

.OutlineLevel = wdOutlineLevel2 ‘2级

tSaveFormat '返回空字符串，表示Word文档

yRecentFiles '返回是否显示最近使用的文档的状态

'返回当前打开的文档数

‘返回当前可用的字体数

‘返回当前文档的水平位置

me '返回当前文档名，包括所在路径

'返回当前文档路径

‘获得文件的相对路径

me '返回文档标准模板名称及所在位置

'返回最近打开的文档数目

yRegion '返回应用程序所在的地区代码

skSpace ‘返回应用程序所在磁盘可用空间

ntalResolution '返回显示器的水平分辨率

alResolution '返回显示器的垂直分辨率

geDesignation '返回系统所使用的语言

processorInstalled ‘返回系统是否安装了数学协处理器

ingSystem ‘返回当前操作系统名

sorType '返回计算机处理器名

n ‘返回操作系统的版本号

'返回应用程序所使用的模板数

me '返回应用程序用户名

n ‘返回应用程序的版本号

(58)

(59)

(60)

(61)

(62)

(63)

述

(64) aphs(1). '返回当前文档中第一段所应用样式的字体名

(65) aphs(1).rEast '返回或设置一种东亚字体名

(66) aphs(1). '返回或设置当前文档中第一段所应用样式的字体大

小

(67) aphs(1).g '返回或设置字符间距

(68) '所选区域的字数 Sentences对象

(69) (1) '所选区域中的第一句的内容 Words对象

(71) (1).Select '选择当前文档中的第一个词

(72) (1).InsertAfter "我爱你！" '在当前文档中的第一个词后插入“我爱你”

4、Characters对象

(73) '当前文档中所选区域的字符数

(74) aphs(1).ParagraphAfter'在当前文档的第一段之后插入一个新段落

5、Sections/Section对象

(75) '当前文档的第一节

(76) Margin '当前文档第一节所在页的底边距

(77) rgin '当前文档第一节所在页的左边距

(78) argin '当前文档第一节所在页的右边距

(79) gin '当前文档第一节所在页的顶边距

(80) ize '返回或设置当前文档第一节所在页的大小

(81) ight '返回或设置当前文档第一节所在页的高度

(82) dth '返回或设置当前文档第一节所在页的宽度

(83) Range:=myRange '在当前文档中添加新节

(84) (2) '当前文档中的第二节

(85) After "文档结束！" '在当前文档中最后一节的结尾添加文字

“文档结束！”

6、Range对象

(86) (Start:=0, End:=10) '表示当前文档前10个字符所组成的一个Range对象

(87) Set myRange = (Start:=aphs(2)., _

End:=aphs(4).) '将当前文档第2段至第4段设置为一个Range对象

(88) aphs(1). '复制当前文档中的第一段

(89)

'复制所选内容到新文档中

(90) rks("Book1").Copy Name:="Book2" '将Book2书签复制Book1书签标记的位置

(91) What:=wdGoToLine, Which:=wdGoToAbsolute, Count:=4 '将所选内容移至文档中的第4

行

(92) What:=wdGoToTable, Which:=wdGoToNext '将所选内容移至下一个表格的第1个单元格

(93) rmat '为所选内容套用格式

(94) = "Arial" '将当前文档的字体设置为斜体

(95) '将当前文档中的内容删除其它

(96) '添加一个新文档

(97) Set myTable = (, 2, 2) '在当前文档所选区域添加一个

2行2列的表格

7、文件读写

(98) Open "C:" For Input As #1 '打开一个用于输入的文件并令其编号为1

(99) Line Input #1, TextLine '读取被打开用于输入且编号为1的文件

(100) Close #1 '关闭编号为1的文件

.OutlineLevel = wdOutlineLevel3 ‘3级

aphs(1).RightIndent ‘返回当前文档中第一段的右缩进量

aphs(1).SpaceBefore '返回当前文档中第一段的段前间距

aphs(1).SpaceAfter ‘返回当前文档中第一段的段后间距

aphs(1). '返回当前文档中第一段的内容

aphs(1).cal '返回当前文档中第一段应用的样式名

aphs(1).ption '返回当前文档中第一段所应用样式的详细描

五、Word表格之VBA知识

Table 对象（因为是对象，所以用Set赋值）

该对象代表一个单独的表格。Table 对象是Tables集合的一个成员。Tables集合包含了指定的选定内容、范围或文

档中的所有表格。

下面是Table的常用方法（注意是部分，不是全部，只例出重要的方法，下面的属性皆如此，如果详细面全部的了解，

请看Word VBA自带的帮助。）

使用Table对象

可使用 Tables(index) 返回一个 Table 对象，其中 index 为索引号。索引号代表选定内容、范围或文档中表

格的位置。下例将活动文档中的第一个表格转换为文本。

(1).ConvertToText Separator:=wdSeparateByTabs

使用Add方法可以在指定范围内新增一表格。下例在活动文档的起始处添加一 3 x 4表格。

Set myRange = (Start:=0, End:=0)

Range:=myRange, NumRows:=3, NumColumns:=4

Cell 方法

返回一个 Cell 对象，该对象代表表格中的一个单元格。

(Row, Column)

expression 必需。该表达式返回一个Table对象。

Row Long 类型，必需。指返回的表格行数。可以是介于 1 和表格行数之间的任意整数。

Column Long 类型，必需。指返回的表格单元格数目。可以是介于 1 和表格列数之间的任意整数。

示例

本示例在新文档中创建一个 3ｘ3 表格，并在表格的第一个和最后一个单元格中插入文本。

Dim docNew As Document

Dim tableNew As Table

Set docNew =

Set tableNew = (, 3, 3)

With tableNew

.Cell(1,1).After "First cell"

.Cell(, _

).After "Last Cell"

End With

本示例删除活动文档的第一个表格中的第一个单元格的内容。

If >= 1 Then

(1).Cell(1, 1).Delete

End If

Split 方法

在表格中紧靠指定行的上面插入一空段落，并且返回一个 Table 对象，此对象包含指定行及其下一行。（简单的的

理解：就是指向拆分后的下面的表格，不清楚也没关系，看下面的例子。）

(BeforeRow)

expression 必需。该表达式返回一个 Table 对象。

BeforeRow Variant 类型，必需。将要拆分的表格的前一行。可以为 Row 对象或行号。

本示例在活动文档（应试是新建文档）中创建一张 5x5 的表格，并且在第三行之前进行拆分。然后为结果表格（新

的 3x5 表格）的单元格添加底纹。

Set newDoc =

Set myTable = (Range:=, _

NumColumns:=5, NumRows:=5)

(BeforeRow:=(3)).Shading _

.Texture = wdTexture10Percent

Table属性

Range 属性

本示例复制表格 1 中的首行。

If >= 1 Then _

(1).Rows(1).

End if

Borders 属性

该属性返回一个 Borders 集合，该集合代表指定对象的所有边框。

s

expression 必需。该表达式返回“应用于”列表中的一个对象。

示例

本示例对活动文档中的第一个表格应用内部和外部边框。

Set myTable = (1)

With s

.InsideLineStyle = wdLineStyleSingle

.OutsideLineStyle = wdLineStyleDouble

End With

Columns 属性

返回一个 Columns 集合，该集合代表在某一区域、所选内容或表格中所有表格列。只读。

示例

本示例显示活动文档的第一个表格中的列数。

If >= 1 Then

MsgBox (1).

End If

本示例将当前列的宽度设置为 1 英寸。

If ation(wdWithInTable) = True Then

th ColumnWidth:=InchesToPoints(1), _

RulerStyle:=wdAdjustProportional

End If

Rows 属性

该属性返回一个 Rows 集合，该集合代表某个范围、所选部分或表格中所有的表格行。只读。

本示例删除活动文档第一个表格的第二行。

(1).Rows(2).Delete

本示例为插入点所在行的各单元格设置边框。

se Direction:=wdCollapseStart

If ation(wdWithInTable) = True Then

(1).eLineStyle = wdLineStyleSingle

Else

MsgBox "The insertion point is not in a table."

End If

Column 对象

代表单个表格列。Column 对象是 Columns 集合的一个元素。Columns 集合包括某一表格、选定内容或区域中的所有列。

使用 Column 对象

使用 Columns(index) 可返回单独的 Column 对象，其中 index 为索引序号。索引序号代表该列在 Columns 集合

中的位置（从左至右计算）。

下列示例选定活动文档中的表格 1 的第一列。

(1).Columns(1).Select

用 Cell 对象的 Column 属性可返回一个 Column 对象。下列示例删除单元格 1 中的文字，插入新文字，然后对

该列进行排序。

With (1).Cell(1, 1)

.

.Before "Sales"

.

End With

用 Add 方法可在表格中添加一列。下列示例为活动文档的第一张表格中添加一列，然后将列宽设置为相等。

If >= 1 Then

Set myTable = (1)

BeforeColumn:=s(1)

buteWidth

End If

说明

用 Selection 对象的 Information 属性可返回当前列号。下列示例选定当前列并在消息框中显示其列号。

If ation(wdWithInTable) = True Then

s(1).Select

MsgBox "Column " _

& ation(wdStartOfRangeColumnNumber)

End If

Cell 对象

代表单个表格单元格。Cell 对象是 Cells 集合中的元素。Cells 集合代表指定对象中所有的单元格。

使用 Cell 对象

用 Cell(row, column) 或 Cells(index)可返回 Cell 对象，其中 row 为行号，column 为列号，index 为索引

序号。下列示例给第一行的第二个单元格加底纹。

Set myCell = (1).Cell(Row:=1, Column:=2)

e = wdTexture20Percent

下列示例给第一行的第一个单元格加底纹。

(1).Rows(1).Cells(1).Shading _

.Texture = wdTexture20Percent

用 Add 方法可在 Cells 集合中添加 Cell 对象。也可用 Selection 对象的 InsertCells 方法插入新单元格。

下列示例在 myTable 的第一个单元格之前插入一个单元格。

Set myTable = (1)

BeforeCell:=(1, 1)

本示例将第一个表格的头两个单元格设定为一个域 (myRange)。区域设定之后，用Merge 方法合并两个单元格。

Set myTable = (1)

Set myRange = ((1, 1) _

., (1, 2).)

说明

使用带 Rows 或 Columns 集合的 Add 方法添加一行或一列单元格。

使用 Selection 对象的 Information 属性返回当前行号和列号。下面的示例改变选中部分第一个单元格的宽度，再显

示单元格的行号和列号。

If ation(wdWithInTable) = True Then

With Selection

.Cells(1).Width = 22

MsgBox "Cell " & .Information(wdStartOfRangeRowNumber) _

& "," & .Information(wdStartOfRangeColumnNumber)

End With

End If

Row 对象

代表表格的一行。Row 对象是 Rows 集合中的一个元素。Rows 集合包括指定部分、区域或表格中的所有行。

使用 Row 对象

用 Rows(index) 可返回单独的 Row 对象，其中 index 为索引序号。索引序号代表该行在选定部分、区域或表格中

的位置。下列示例删除活动文档中第一张表格的首行。

(1).Rows(1).Delete

用 Add 方法可在表格中添加行。下列示例在选定部分首行前插入一行。

If ation(wdWithInTable) = True Then

BeforeRow:=(1)

End If

说明

用 Cells 属性可修改 Row 对象中的单个单元格。下列示例在选定部分中添加一张表格，并在表格第二行的各单元格内

插入数字。

se Direction:=wdCollapseEnd

If ation(wdWithInTable) = False Then

Set myTable = _

(Range:=, _

NumRows:=3, NumColumns:=5)

For Each aCell In (2).Cells

i = i + 1

= i

Next aCell

End If

访问表格行或列时产生的错误

如果要访问绘制表格中单独的行或列，而该表格又不统一，则会产生一个运行时错误。例如，如果活动文档中第一张表格的

每列中具有不同数量的行，则使用下列指令将导致出错。

Sub RemoveTableBorders()

(1).Rows(1). = False

End Sub

要避免这种错误，可首先使用 SelectColumn 或 SelectRow 方法选定一列或一行中的单元格。选定单元格后，再使

用 Selection 对象的 Cells 属性。下列示例选定第一张文档表格中的第一行。Cells 属性用于访问选定的单元格（第

一行中的所有单元格）以删除边框。

Sub RemoveTableBorders()

(1).Cell(1, 1).Select

With Selection

.SelectRow

. = False

End With

End Sub

下列示例选定第一张文档表格的第一列。Next 循环语句用于在所选内容（第一列中的所有单元格）的每个单

元格中添加文字。

Sub AddTextToTableCells()

Dim intCell As Integer

Dim oCell As Cell

(1).Cell(1, 1).Select

Column

intCell = 1

For Each oCell In

= "Cell " & intCell

intCell = intCell + 1

Next oCell

End Sub

处理表格

创建一张表格，插入文字，并应用格式

下列示例在活动文档的开头插入一张 4 列 3 行的表格。Next 结构用于循环遍历表格中的每个单元格。

在 Next 结构中，InsertAfter 方法用于将文字添至表格单元格（单元格 1、单元格 2、以此类推）。

Sub CreateNewTable()

Dim docActive As Document

Dim tblNew As Table

Dim celTable As Cell

Dim intCount As Integer

Set docActive = ActiveDocument

Set tblNew = ( _

Range:=(Start:=0, End:=0), NumRows:=3, _

NumColumns:=4)

intCount = 1

For Each celTable In

After "Cell " & intCount

intCount = intCount + 1

Next celTable

rmat Format:=wdTableFormatColorful2, _

ApplyBorders:=True, ApplyFont:=True, ApplyColor:=True

End Sub

在表格单元格中插入文字

下列示例在活动文档中第一张表格的第一个单元格中插入文字。Cell 方法返回单独的Cell 对象。Range 属性返回一

个 Range 对象。Delete 方法用于删除现有的文字，而InsertAfter 方法用于插入文字“Cell 1,1”。

Sub InsertTextInCell()

If >= 1 Then

With (1).Cell(Row:=1, Column:=1).Range

.Delete

.InsertAfter Text:="Cell 1,1"

' .text="cell 1,1" 上面两行，可以用这一行表示。

End With

End If

End Sub

返回表格单元格中的文字，不包括表格结束单元格标记

下列示例返回并显示文档中第一张表格的第一行中每个单元格的内容。

Sub ReturnTableText()

Dim tblOne As Table

Dim celTable As Cell

Dim rngTable As Range

Set tblOne = (1)

For Each celTable In (1).Cells

Set rngTable = (Start:=, _

End:= - 1) '注意这里用了-1

MsgBox

Next celTable

End Sub

Sub ReturnCellText()

Dim tblOne As Table

Dim celTable As Cell

Dim rngTable As Range

Set tblOne = (1)

For Each celTable In (1).Cells

Set rngTable =

d Unit:=wdCharacter, Count:=-1

MsgBox

Next celTable

End Sub

将文本转换为表格

下列示例在活动文档的开头插入用制表符分隔的文本，然后将这些文本转换为表格。

Sub ConvertExistingText()

With t

.InsertBefore "one" & vbTab & "two" & vbTab & "three" & vbCr

.ConvertToTable Separator:=Chr(9), NumRows:=1, NumColumns:=3

End With

End Sub

返回每个表格单元格的内容

下列示例定义一个数组，该数组的元素个数等于文档中第一张表格（假定为 Option Base 1）中的单元格数。For

Next 结构用于返回每个表格单元格的内容，并将文字指定给相应的数组元素。

Sub ReturnCellContentsToArray()

Dim intCells As Integer

Dim celTable As Cell

Dim strCells() As String

Dim intCount As Integer

Dim rngText As Range

If >= 1 Then

With (1).Range

intCells = .

ReDim strCells(intCells)

intCount = 1

For Each celTable In .Cells

Set rngText =

d Unit:=wdCharacter, Count:=-1

strCells(intCount) = rngText

intCount = intCount + 1

Next celTable

End With

End If

End Sub

(测试环境.doc的VBA中有更好的方法，可以参考)

将活动文档中的所有表格复制到新文档中

本示例将当前文档中的表格复制到新文档中。

Sub CopyTablesToNewDoc()

Dim docOld As Document

Dim rngDoc As Range

Dim tblDoc As Table

If >= 1 Then

Set docOld = ActiveDocument

Set rngDoc = (Start:=0, End:=0)

For Each tblDoc In

With rngDoc

.Paste

.Collapse Direction:=wdCollapseEnd

.InsertParagraphAfter

.Collapse Direction:=wdCollapseEnd

End With

Next

End If

End Sub

以下为我对表格的认识：（陋见）

在“测试环境.doc”中有不少的例子（在VBA中），也有解释，

两个文档花了我8小时以上（即一个工作日以上）

关于表格在VBA中的相关说明：

1. 如下图，类似于回车 在VBA中也是chr(13)，竖线就是chr(7)，怎么知道的？

2. 当然是看老大们知道的。不过。在“测试环境.doc”中有相关的宏能得到这些数字。这也是授之以渔

吧。

3. 重点推荐“测试环境.doc”的相关代码用了我不少功夫，慢慢体会。不懂的可以提出来。

Ch(13)

Ch(7)

4. 因为chr(13)为段落标记，所以在VBA中，测得的段落数与工具、

字数统计是不一样的。

5. 如果这样统计：表格中单元格中类似的 且不为空就为一个段落，否则不算。这就与工工具、字数统

计的段落数一样了。

6. 如果要新建一个表格，再添加一些字符（包括数字）的话，更好的方法是：先字符写入文档中（当然，

要加一些标记，以便确定单元格），再利用Word的表格、转换、文字转换为表格。这样，速度快一些。有以下的代码

为证。

Sub 表格5()

'先放到文档，再放入表格

Dim i%, astring As String

Dim adoc As Document

Dim atime As Long

Updating = False '关闭屏幕更新

atime = Timer '设atime为正前时间

For i = 1 To 1000

astring = astring & i & Chr(13)

Next

Set adoc =

t = astring

tToTable Separator:=wdSeparateByParagraphs, NumColumns:=10, _

NumRows:=100

Updating = True

MsgBox "先放到文档的运行时间为：" & Timer - atime

'1.28,1.07,1.03

End Sub

Sub 表格6()

'先生成表格，再向单元格中添数

Dim i%, astring As String

Dim adoc As Document

Dim atime As Long

Dim atable As Table

Updating = False '关闭屏幕更新

atime = Timer '设atime为正前时间

Set adoc =

Set atable = (, 100, 10)

With

For i = 1 To 1000

.Cells(i). = i

Next

End With

Updating = True

MsgBox "先放到文档的运行时间为：" & Timer - atime

'16.3,15.53,15.35

End Sub

'几乎是15倍的差别，谁快谁慢应该大家知道了。还顺带说一话：有的软件在操作Word的表格时，就是用类似于“表

格6”的方法，而且也没有用Updating=true。所以，看上去就像在看动画片。（例如：“青山预算之

星”的“输出到Word”就是）看来，国产软件还需努力。

7. 有些尤意末尽的，大家慢慢在程序中体会。

8. 特别强调：微软本身的许多功能，不是一般的VBA的程序，比VBA要快很多，不明白内部是用什么语

言或什么原理在工作。例如：a.邮件合并，速度奇快。如果你试着用VBA来做，速度奇慢。b.修订功能；c.工具、宏、

命令listcommands的运行速度。等等，都是我们VBA一族所不能及的。

六、例子。(例中的操作全部是录制，然后嫁接的)

例子：用Excel VBA，将如下Excel表格（从考试系统中导出的题库）生成如下Word文档

Excel表格：

规程名称 题型 题目内容 答案A 答案B 答案C 答案D 正确答案 分值 有否图形

规程1

规程1

规程2

规程2

选择题

判断题

选择题

判断题

题目1……

题目2……

题目3……

题目4……

……

……

……

……

……

……

……

……

ABCD

对

A

错

2

2

2

2

Word文档：

规程1

一、选择题

1、题目1…… （ABCD）

A、……

B、……

C、……

D、……

二、判断题

1、题目2…… （对）

规程2

一、选择题

1、题目3…… （A）

A、……

B、……

C、……

D、……

二、判断题

1、题目4…… （错）

Sub ScWordWd()

'将“题库”中的题目，按格式生成Word文档

Dim I As Integer, J As Integer, Zhs As Integer, Xh As Integer, Dls As String

Dim Lr As String, Bt As String, Bt1 As String, Tx As String, Tx1 As String

Dim Lj As String, Wjm As String

Dim AA

Sheets("题库").Select

Zhs = Sheets("题库").

Bt = Cells(1, 1) '标题

Tx = Cells(1, 2) '题型

Xh = 1 '序号

Dls = 1 '段落数

'Dim WordApp As Object

'Set WordApp = CreateObject("ation") '新建Word对象

Dim Wordapp As ation

Set Wordapp = New ation '新建Word对象

e = True '可见

'Updating = False '屏幕刷新

Dim WordD As nt '定义word类

Set WordD = '新建文档

tory '全选

= "宋体" '字体

= 10 '字号

For I = 2 To Zhs

Bt1 = Cells(I, 1)

aphs(Dls). = "宋体" '字体

aphs(Dls). = 10 '字号

If Len(Trim(Bt1)) > 0 Then

Tx1 = Cells(I, 2)

Lr = Cells(I, 3)

If Bt1 <> Bt Then '标题不同，写标题，居中

If I > 5 Then '第一次肯定不同，规程1前不插入分节符

aphs(Dls).After (vbCrLf) '插入回车符，增加一段

Dls = Dls + 1

aphs(Dls).

'Break Type:=wdPageBreak

'aphs(Dls).Break Type:=wdPageBreak '插入分页符，

两个都没反应？

Break Type:=wdSectionBreakNextPage '插入分节符（下一

页）

aphs(Dls).After (vbCrLf) '插入回车符，增加一段

Dls = Dls + 1

End If

Bt = Bt1

aphs(Dls). = Bt & vbCrLf '写标题

'aphs(Dls).After (vbCrLf) '插入回车符，增加一段

aphs(Dls).OutlineLevel = wdOutlineLevel2 '设置大纲级别，2级

'aphs(Dls).ineIndent = CentimetersToPoints(0)

aphs(Dls).ineIndent = 0 '取消首行缩进

'aphs(Dls). = "宋体" '字体

'aphs(Dls). = 10 '字号

aphs(Dls).ent = wdAlignParagraphCenter

'居中排列

aphs(Dls). = wdToggle '加粗

Dls = Dls + 1

Xh = 1

End If

If Tx1 <> Tx Then '题型不同，写题型

If Tx1 = "选择题" Then

aphs(Dls). = "一、选择题" '写题型

Else

aphs(Dls).After (vbCrLf) '插入回车符，增加一段

Dls = Dls + 1

aphs(Dls). = "二、判断题" '写题型

End If

Tx = Tx1

aphs(Dls).ent = wdAlignParagraphJustify '

左对齐

'aphs(Dls).ineIndent = CentimetersToPoints(0.35)

'首行缩进2字符,时能用时不能用，CentimetersToPoints不能被Excel识别？

aphs(Dls).ineIndent = 20 '首行缩进，20

大约相当于5号字的2字符

aphs(Dls).After (vbCrLf) '插入回车符，增加一段

aphs(Dls). = wdToggle '加粗

Dls = Dls + 1

Xh = 1

End If

If Tx = "选择题" Then

aphs(Dls). = Xh & "、" & Lr & " （" & Cells(I, 8) & "）" & vbCrLf

'写题目及标准答案

Dls = Dls + 1

aphs(Dls). = "A、" & Cells(I, 4) & vbCrLf '选项A

Dls = Dls + 1

aphs(Dls). = "B、" & Cells(I, 5) & vbCrLf '选项B

Dls = Dls + 1

aphs(Dls). = "C、" & Cells(I, 6) & vbCrLf '选项C

Dls = Dls + 1

If Len(Trim(Cells(I, 7))) > 0 Then

aphs(Dls). = "D、" & Cells(I, 7) & vbCrLf '选项D

Dls = Dls + 1

End If

Xh = Xh + 1

Else

aphs(Dls). = Xh & "、" & Lr & " （" & Cells(I, 8) & "）" & vbCrLf

'写题目及标准答案

Dls = Dls + 1

Xh = Xh + 1

End If

End If

Next I

State = wdWindowStateMinimize '最小化窗口

'Updating = True '屏幕刷新

' '

'Set WordD = Nothing

'Set Wordapp = Nothing

' '退出Word对象

te

End Sub