利用vba排版1

目录

目录

目录 .................................................................................................................................................. 1

一.使用VBA处理表格 ..................................................................................................................... 2

实例1：将每个表格在文档中的以页面为基准居中对齐 .................................................... 2

实例2：将每个表格中的所有文本在单元格中自动居中对齐 ............................................ 2

实例3：删除文档中的所有表格 ............................................................................................ 3

实例4：删除文档中的所有表格包含的空行 ........................................................................ 3

实例5：在表格第一列的每个单元格中插入指定的图片 .................................................... 4

实例6：自动将文档中的每个表格上方的标题汇总到新文档中 ........................................ 5

实例7：下面的代码一次性删除文档中所有表格的内外边框线和底纹效果 .................... 6

实例8：统一设置所有表格标题行的底纹颜色 .................................................................... 7

实例9：统一设置所有表格的边框线样式 ............................................................................ 8

二 .使用VBA处理图片和图形对象 ............................................................................................. 10

实例1：将所有图片的宽度统一设置为7厘米 .................................................................. 10

实例2：快速为所有图片添加边框 ...................................................................................... 10

实例3：下面的代码将文档中的所有图形填充色设置为红色 .......................................... 11

实例4：快速改变所有文本框中的字体颜色 ...................................................................... 12

实例5：批量删除文档中的所有图片 .................................................................................. 12

实例6：批量删除文档中的所有自选图形 .......................................................................... 12

实例7：批量删除文档中的所有文本框 .............................................................................. 13

三．使用VBA处理文本 ................................................................................................................ 13

实例1：快速将指定内容提取到新文档中 .......................................................................... 13

实例2：批量设置不连续文本的格式 .................................................................................. 15

实例3：批量设置不连续段落的格式 .................................................................................. 15

实例4：快速删除文档中的所有空行 .................................................................................. 16

1

一.使用VBA处理表格

实例1：将每个表格在文档中的以页面为基准居中对齐

代码：

Sub 将每个表格在文档中以页面为基准居中对齐()

Dim tbl As Table

For Each tbl In

ent = wdAlignRowCenter

Next tbl

Set tbl = Nothing

End Sub

代码解析：Table对象的Rows代表表格中的所有行。

Rows集合的Aligment属性用于设置整个表格在页面中的对

齐方式：wdAlignRowCenter居中（wdAlignRowLeft左对齐

默认值，wdAlignRowRight右对齐）

实例2：将每个表格中的所有文本在单元格中自动居中对齐

代码：

Sub 将每个表格中的所有文本在单元格中自动居中对齐()

Dim tbl As Table

For Each tbl In

2

ent = wdAlignParagraphCenter

Next tbl

Set tbl = Nothing

End Sub

代码解析：Table对象的Range属性返回一个Range对象，代表一

个表格在文档中的范围，使用Range对象的ParagphForment属性

返回一个ParagraphFormat对象，用于设置表格内容的段落格式，

ParagraphFormat对象的Aligement属性用于设置段落的对齐方式。

实例3：删除文档中的所有表格

代码：

Sub 删除文档中的所有表格()

Dim tbl As Table

For Each tbl In

Next tbl

Set tbl = Nothing

End Sub

实例4：删除文档中的所有表格包含的空行

代码：

Sub 删除文档中的所有表格包含的空行()

Dim tbl As Table

Dim iRow As Integer

For Each tbl In

For iRow = To 1 Step -1

3

If Len((iRow).) = ( + 1) * 2 Then

(iRow).Delete

End If

Next iRow

Next tbl

Set tbl = Nothing

End Sub

代码解析：表格中的一个空白单元格的长度为2=1个段落标记+1个

表格边框线，每行最后一个单元格右侧，也就是位于表格外侧还有

一个段落标记，该段落标记的长度也为2，因此，需要检测每行的总

长度是否等于（表格列数+1）X2如果是则说明该行为空行，否则不

是空行，Len（（iRow）.）语句表示表格某行

包含文本的总长度

实例5：在表格第一列的每个单元格中插入指定的图片

自动插入6张照片第一个表格中的第一列的每个单元格中，6张图片和

表格所属的文档位于同一个文件夹中。

代码：

Sub 在表格第一列的每个单元格中插入指定的图片()

Dim i As Integer

Dim vPic As Variant

Dim sFullName As String

Dim tbl As Table

On Error Resume Next

Set tbl = (1)

If <> 0 Then

MsgBox "请先创建一个不少于6行的表格"

4

Exit Sub

End If

vPic = Array("辣椒", "胡萝卜", "西红柿", "柚子", "草莓", "猕猴桃")

For i = LBound(vPic) To UBound(vPic)

sFullName = & "" & vPic(i) & ".jpg"

s(1).Cells(i + 1).ture sFullName

Next i

Set tbl = Nothing

End Sub

实例6：自动将文档中的每个表格上方的标题汇总到新文档中

如果文档中的每个表格上面的一行都包含一个标题，下面的代码将

与每个表格相关的标题提取到一个新文档中

代码：

Sub 自动将文档中的每个表格上方的标题汇总到新文档中()

Dim tbl As Table

Dim rng As Range

Dim sTitle As String

For Each tbl In

Set rng = ( - 1, - 1)

(wdParagraph)

sTitle = sTitle &

Next tbl

= sTitle

Set tbl = Nothing

Set rng = Nothing

End Sub

5

代码解析：代码中声明了三个变量，tbl变量常用于遍历文档中的每

一个表格，rng变量用于指定表格上方的标题范围，sTitle变量用于

保存所有表格的标题，使用tbl变量遍历当前文档的每一个表格，在

遍历每个单元格时，定义rng变量的范围为表格上方的段落的结尾

位置，返回整个表格在文档中的范围，返

回表格的起始位置，将该值减1得到上一个段落结尾的位置，使用

Range对象的Expand方法将rng变量中定义范围拓展到整个段落，

然后将rng变量所表示的范围中的内容赋值给sTitle变量，在文档的

每个表格中重复以上操作，最后将Stitle变量中保存的所有表格的标

题写入新建的文档中。

实例7：下面的代码一次性删除文档中所有表格的内外边框线和底纹

效果

代码：

Sub 删除打开的所有文档中所有表格的内外边框线和底纹效果()

Dim doc As Document

Dim tbl As Table

For Each doc In Documents

For Each tbl In

eLineStyle = wdLineStyleNone

LineStyle = wdLineStyleNone

(1).oundPatternColor = wdColorAutomatic

Next tbl

Next doc

6

Set doc = Nothing

Set tbl = Nothing

End Sub

实例8：统一设置所有表格标题行的底纹颜色

下面的代码自动将当前文档中的所有表格的标题行设置灰色底纹

代码：

Sub 统一设置所有表格标题行的底纹颜色()

Dim tbl As Table

For Each tbl In

(1).oundPatternColor = wdColorGray15

Next tbl

Set tbl = Nothing

End Sub

代码解析：Table对象的Ros属性代表表格中的所有行，使用Rows

（1）引用表格的第一行同时返回一个Row对象，然后使用Row对

象的Shading属性设置表格的底纹效果。本例中的wdColorGray15

表示12%灰度，更多颜色：

常量值 说明

wdColorAutomatic 自动配色，

默认值。一般取决于文档的主题颜色

wdColorGray05 5%灰色底纹

wdColorGray10 10%灰色底纹

wdColorGray125 12.5%灰色底纹

wdColorGray375 37.5%灰色底纹

（其他量值改下数据就可以）

7

wdColorBlue 蓝色

wdColorBlack 黑色

wdColorBrown 褐色

wdColorRed 红色

wdColorGreen 绿色

wdColorYellow 黄色

wdColorViolet 紫色（其他颜色一样设置，查下颜色的英

语就可以）

实例9：统一设置所有表格的边框线样式

下面代码将当前表格的外边框线设置为1.5磅宽的单线，将内边框线

设置为1磅的点划线

代码：

Sub 统一设置所有表格的边框线样式()

Dim tbl As Table

For Each tbl In

With s

.OutsideLineStyle = wdLineStyleSingle

.OutsideLineWidth = wdLineWidth150pt

.InsideLineStyle = wdLineStyleDashDot

.InsideLineWidth = wdLineWidth100pt

End With

Next tbl

Set tbl = Nothing

End Sub

8

代码解析：设置表格边框线线型需要使用WdlineStyle常量，该常量

的取值情况：

常量值说明

wdLineStyleNone 无边框

wdLineStyleSingle 单实线

wdLineStyleDouble

wdLineStyleTriple

双实线

三条细实线

wdLineStylesingleWavy 波浪型单实线

wdLineStyleDot

wdLineStyleDashDot

wdLineStyleDashDotDot 划线后跟两个点

wdLineStyleDashDotStroked 划线后跟粗点

表格边框线宽度的WdlineWidth常量的取值情况：

常量值

wdlineWidth025pt

说明

0.25磅

点

划线后跟单个点

wdlineWidth050pt 0.5磅

wdlineWidth075pt

wdlineWidth100pt

9

0.75磅

1磅，默认值

wdlineWidth150pt 1.5磅

其他磅值类似，同学们自己改下数字就可以了，要学会举一反三

二 .使用VBA处理图片和图形对象

实例1：将所有图片的宽度统一设置为7厘米

代码：

Sub 将所有图片的宽度统一设置为7厘米()

Dim InShp As InlineShape

For Each InShp In Shapes

With InShp

If .Type = wdInlineShapePicture Then

.LockAspectRatio = msoTrue

.Width = CentimetersToPoints(7)

End If

End With

Next InShp

Set InShp = Nothing

End Sub

代码解析：声明一个InlineShape类型的对象变量InShp，使用该变

量遍历文档中的所有嵌入型的对象，通过InlineShape对象的Type

属性判断InShp变量当前引用的对象是否是图片，如果是则锁定图

片的宽高比，然后将图片宽度设置成7厘米。

实例2：快速为所有图片添加边框

代码：

Sub 快速为所有图片添加边框()

Dim InShp As InlineShape

For Each InShp In Shapes

10

With InShp

If .Type = wdInlineShapePicture Then

. = True

End If

End With

Next InShp

Set InShp = Nothing

End Sub

代码解析：使用InShp变量在文档中遍历图片的方法与上面讲的类

似，将InlineShape对象的Borders属性设置为True表示为图片应

用默认边框。

实例3：下面的代码将文档中的所有图形填充色设置为红色

代码：

Sub 快速为所有形状设置填充色()

Dim shp As Shape

For Each shp In

With shp

If .Type = msoAutoShape Then

.lor = vbRed

End If

End With

Next shp

Set shp = Nothing

End Sub

代码解析：声明一个Shape类型的变量shp,使用该变量遍历当前文

档中的每一个浮动型对象，然后使用Shape对象的Type属性判断

shp变量当前引用的对象是否是自选图形，如果是则将该图形的前景

设置为红色。

11

实例4：快速改变所有文本框中的字体颜色

统一将文本框的文字颜色设置为蓝色

代码：

Sub 快速改变所有文本框中的字体颜色()

Dim shp As Shape

For Each shp In

If = msoTextBox Then

ndex = wdBlue

End If

Next shp

Set shp = Nothing

End Sub

代码解析:声明一个Shape类型的变量shp，使用该变量遍历当前文

档中的每一个浮动型对象，然后使用Shape对象的Type属性判断

shp变量当前引用的对象是否是文本框，如果是则该文本框的文字颜

色设置为蓝色。（wdBlue中的Blue同学可以更改成需要的颜色）

实例5：批量删除文档中的所有图片

代码：

Sub 批量删除文档中的所有图片()

Dim InShp As InlineShape

For Each InShp In Shapes

If = wdInlineShapePicture Then

End If

Next InShp

Set InShp = Nothing

End Sub

实例6：批量删除文档中的所有自选图形

代码：

Sub 批量删除文档中的所有自选图形()

Dim shp As Shape

For Each shp In

12

If = msoAutoShape Then

End If

Next shp

Set shp = Nothing

End Sub

实例7：批量删除文档中的所有文本框

代码：

Sub 批量删除文档中的所有文本框()

Dim shp As Shape

For Each shp In

If = msoTextBox Then

End If

Next shp

Set shp = Nothing

End Sub

三．使用VBA处理文本

实例1：快速将指定内容提取到新文档中

下面的代码将当前文档中包含“word”一词中的所有句子提取到一

个新文档中。

代码：

Sub 快速将指定内容提取到新文档中()

Dim sFindText As String

With Selection

.HomeKey wdStory

With .Find

.ClearFormatting

.Text = "Word"

.MatchCase = True

.Forward = True

Do

.Execute

If .Found = False Then Exit Do

. (wdSentence)

13

sFindText = sFindText & & vbCrLf

.se wdCollapseEnd

Loop

End With

End With

= sFindText

End Sub

代码解析：先使用Selection的HomeKey方法将插入点移至文

档开头，然后设置查找条件，查找Word一词严格要求匹配大小写，

接着使用Do Loop循环按照设置好的条件反复查找指定的内容，使

用Find对象的Found属性判断是否找到匹配项，如果未找到则退出

Do Loop循环，如果找到匹配项会自动选中该内容，然后将选区拓

展到该词所在的句子，同时将每次找到并拓展后的内容存入

sFindText变量中，然后将选区折叠到结尾处，继续进行查找，最后

新建一个文档，将所有找到的内容输入到新文档中。

更灵活的做法是运行程序后显示一个对话框，允许用户输入要提取

的内容，然后根据输入的内容提取相应范围中的内容，而不是将要

提取的内容输入到代码中，从而形成缺少灵活性的硬编码，下面是

修改后的代码，使用VBA的InputBox函数所创建的对话框接受用

户输入的内容，然后检测输入的内容是否为空或者直接单击对话框

中的取消按钮，如果是则退出程序，否则在文档中查找输入的内容，

找到匹配项则进行提取。

代码：

Sub 快速将指定内容提取到新文档中2()

Dim sFindText As String, sAns As String

sAns = InputBox("请输入要提取的关键字", "自动提取内容")

If sAns = "" Then Exit Sub

With Selection

.HomeKey wdStory

14

With .Find

.ClearFormatting

.Text = sAns

.MatchCase = True

.Forward = True

Do

.Execute

If .Found = False Then Exit Do

. (wdSentence)

sFindText = sFindText & & vbCrLf

.se wdCollapseEnd

Loop

End With

End With

= sFindText

End Sub

实例2：批量设置不连续文本的格式

下面的代码将当前文档第一段中的第一段中的1、3、5、7、9 这

几个序列的文字字体设置为红色并加粗显示

代码：

Sub 批量设置不连续文本的格式()

Dim avWord As Variant, i As Integer

avWord = Array(1, 3, 5, 7, 9)

For i = LBound(avWord) To UBound(avWord)

With ActiveDocument

With .Paragraphs(1).(avWord(i)).Font

.ColorIndex = wdRed

.Bold = True

End With

End With

Next i

End Sub

实例3：批量设置不连续段落的格式

下面的代码会将文档中的第1、3、6段的大纲级别设置成1级。

15

代码：

Sub 批量设置不连续段落的格式()

Dim avPara As Variant, i As Integer

avPara = Array(1, 3, 6)

For i = LBound(avPara) To UBound(avPara)

With ActiveDocument

.Paragraphs(avPara(i)).eLevel = wdOutlineLevel1

End With

Next i

End Sub

实例4：快速删除文档中的所有空行

代码:

Sub 快速删除文档中的所有空行()

Dim para As Paragraph

Updating = False

For Each para In aphs

If Len() = 1 Then

End If

Next para

Updating = True

End Sub

代码解析:空行其实就是只包含一个段落标记的空白段落，因此可以

通过判断一个段落的长度来确定是否是一个空白段落，如果段落长

度为1，则说明该段落只要一个段落标记，通过使用一个Paragraph

类型的对象变量，遍历文档中的每一个段落并判断段落的长度是否

为1，如果是则说明该段落只包含一个段落标记，将其删除即可。

16