word公文自动排版VBA代码，拿走不谢

Sub 文档初始化() '公文格式初始化

Selection.WholeStory '选择word 所有文档

Selection.ClearFormatting '文档格式清除

Selection.Range.HighlightColorIndex = wdNoHighlight '突出显示文本取消

With Selection.Paragraphs '段落设置

.Alignment = wdAlignParagraphLeft '左对齐

.LineSpacingRule = wdLineSpaceExactly '行距固定28.8

.LineSpacing = 28.8

.IndentFirstLineCharWidth 3 '首行缩进2个字符

End With

With Selection.Font '字体设置

.Name = "仿宋_GB2312" '字体名称

.Size = 16 '三号字体

.ColorIndex = wdBlack '黑色

End With

End Sub

Sub 标题正文设置()

With Selection.PageSetup '页面设置

.TopMargin = CentimetersToPoints(3.7) '顶端边距

.BottomMargin = CentimetersToPoints(3.5) '底端边距

.LeftMargin = CentimetersToPoints(2.8) '左边距

.RightMargin = CentimetersToPoints(2.6) '右边距

'.PageWidth = CentimetersToPoints(18.2) '页面宽度

'.PageHeight = CentimetersToPoints(25.7) '页面高度

End With

'字体设置

Dim title_reg, f_reg, s_reg, th_reg, fr_reg, k, mh, strA$

Set myRange = ActiveDocument.Content

' 正则表达式 获取文档内容

strA = myRange.Text

Set title_reg = CreateObject("vbscript.regexp")

Set f_reg = CreateObject("vbscript.regexp")

Set s_reg = CreateObject("vbscript.regexp")

Set th_reg = CreateObject("vbscript.regexp")

Selection.HomeKey unit:=wdStory '光标回到文章开头

t = 0

title_reg.Pattern = "\r\r"

'[^\r]除了换行符之外的所有字符

title_reg.Global = True

Set Title = title_reg.Execute(strA)

With Selection.Find

.ClearFormatting

.Text = Title.Item(0)

.Execute Forward:=True

Selection.HomeKey unit:=wdStory, Extend:=wdExtend

End With

'选择有两个换行符的至开头的所有段落

With Selection.Font

.Name = "方正小标宋简体"

.Size = 22

.ColorIndex = wdBlack

End With

With Selection.Paragraphs '设置行距

.FirstLineIndent = CentimetersToPoints(0) '取消首行缩进

.Alignment = wdAlignParagraphCenter '段落居中

.LineSpacingRule = wdLineSpaceExactly '行距固定

.LineSpacing =
Word.Application.LinesToPoints(2.3) '行距为2.3倍行距 一行距=12

End With

' 以下是设置一级标题

t1 = 0 '初始化t1，作为一级标题是否是一是二是三是的标记，如果是，则为1，不是则为0

Selection.HomeKey unit:=wdStory

f_reg.Pattern = "(一、|二、|三、|四、|五、|六、|七、|八、|九、|十、|十一、|十二、|十三、|十四、|十五、|十六、|十七、|十八、|十九、|二十、|二十一、|二十二、|二十三、|二十四、|二十五、|二十五、|二十五、|二十六、|二十七、|二十八、|二十九、|三十、)[^\r]*\r"

f_reg.Global = True

Set f_titles = f_reg.Execute(strA)

If f_titles.Count = 0 Then '如果一级标题是一是二是三是，则匹配

f_reg.Pattern = "(一是|二是|三是|四是|五是|六是|七是|八是|九是|十是|十一是|十二是|十三是|十四是|十五是|十六是|十七是|十八是|十九是|二十是|二十一是|二十二是|二十三是|二十四是|二十五是|二十六是|二十七是|二十八是|二十九是|三十是)([^。])*。"

Set f_titles = f_reg.Execute(strA)

t1 = 1

End If

For Each f_title In f_titles

With Selection.Find

.ClearFormatting

.Text = f_title.Value

Debug.Print "一级标题遍历项目："; f_title.Value

.Execute Forward:=True

End With

With Selection.Font

.Name = "黑体"

.Size = "16"

.ColorIndex = wdBlack

End With

Selection.HomeKey unit:=wdStory

Next

' 以下是设置二级标题

If t1 = 0 Then 'p判断一级标题是否是一是二是三是的标记，如果是0，则不是一是二是三是，则执行，不是则不执行

t2 = 0

Selection.HomeKey unit:=wdStory

s_reg.Global = True

s_reg.Pattern = "(（一）|（二）|（三）|（四）|（五）|（六）|（七）|（八）|（九）|（十）|（十一）|（十二）|（十三）|（十四）|（十五）|（十六）|（十七）|（十八）|（十九）|（二十）|（二十一）|（二十二）|（二十三）|（二十四）|（二十五）|（二十六）|（二十七）|（二十八）|（二十九）|（三十）)([^。\r：])*[。|\r：]" '排除句号和段落符号查找所有，找到句号或段落符号后停止

Set s_titles = s_reg.Execute(strA)

If s_titles.Count = 0 Then '如果二级标题是一是二是三是，则匹配

s_reg.Pattern = "(一是|二是|三是|四是|五是|六是|七是|八是|九是|十是|十一是|十二是|十三是|十四是|十五是|十六是|十七是|十八是|十九是|二十是|二十一是|二十二是|二十三是|二十四是|二十五是|二十六是|二十七是|二十八是|二十九是|三十是)([^。])*。"

Set s_titles = s_reg.Execute(strA)

t2 = 1

End If

For Each s_title In s_titles

With Selection.Find

.ClearFormatting

.Text = s_title.Value

Debug.Print "二级标题遍历项目："; s_title.Value

.Execute Forward:=True

End With

With Selection.Font

.Name = "楷体"

.Size = "16"

.ColorIndex = wdBlack

.Bold = True

End With

Selection.HomeKey unit:=wdStory

Next

End If

' 以下是设置三级标题

If t2 = 0 Then

Selection.HomeKey unit:=wdStory

th_reg.Global = True

th_reg.Pattern = "\r\d{1,2}\.([^。])*。"

Set th_titles = th_reg.Execute(strA)

If th_titles.Count = 0 Then '如果三级标题是一是二是三是，则匹配

th_reg.Pattern = "(一是|二是|三是|四是|五是|六是|七是|八是|九是|十是|十一是|十二是|十三是|十四是|十五是|十六是|十七是|十八是|十九是|二十是|二十一是|二十二是|二十三是|二十四是|二十五是|二十六是|二十七是|二十八是|二十九是|三十是)([^。])*。"

Set th_titles = th_reg.Execute(strA)

End If

For Each th_title In th_titles

With Selection.Find

.ClearFormatting

.Text = th_title.Value

Debug.Print "三级标题遍历项目："; th_title.Value

.Execute Forward:=True

End With

With Selection.Font

.Bold = True

.ColorIndex = wdBlack

End With

Selection.HomeKey unit:=wdStory

Next

End If

End Sub

Sub 页码设置()

ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).PageNumbers.Add PageNumberAlignment:=wdAlignPageNumberCenter, FirstPage:=True

With ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary) '进入页脚编辑状态

.Range.Font.Size = 15

.Range.Font.Name = "仿宋"

.Range.Collapse Direction:=wdCollapseEnd

End With

End Sub

Sub 删除页眉横线()

With ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range '进入页脚编辑状态

.Delete '删除页眉中的内容

.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleNone '段落下边框线

End With

End Sub

Sub 公文格式排版()

Call 文档初始化

Call 标题正文设置

Call 页码设置

Call 删除页眉横线

End Sub