VBA Word排版 | VBA实例教程

Sub 自动排版word()
Dim filepath, filename, paragraphcount, myrange
filepath = ThisDocument.Path & "\"   '当前路径
filename = Dir(filepath & "*.docx")  '遍历文件
Do
Documents.Open (filepath & filename) '打开文档
paragraphcount = ActiveDocument.Paragraphs.Count '计算段数
With ActiveDocument.Paragraphs(1).Range    '设置第一段格式
.Font.Name = "黑体"                      '字体
.Font.Size = 16                          '字号
.ParagraphFormat.Alignment = wdAlignParagraphCenter  '对齐方式
End With
Set myrange = ActiveDocument.Range(Start:=ActiveDocument.Paragraphs(2).Range.Start, End:=ActiveDocument.Paragraphs(paragraphcount).Range.End)     '设置区域，从第2段到最后一段
myrange.Select           '选中正文
With Selection.ParagraphFormat
.LeftIndent = CentimetersToPoints(0.5)   '左缩进
.RightIndent = CentimetersToPoints(0.8)  '右缩进
.LineSpacingRule = wdLineSpaceSingle     '行距
.CharacterUnitFirstLineIndent = 3        '首行缩进
End With
Selection.Start = Selection.Start + 1     '这句不能少，否则分栏将题目也带上了
With Selection
.Font.Name = "宋体"
.Font.Size = 11
.PageSetup.TextColumns.SetCount numcolumns:=2  '分栏
.PageSetup.TextColumns.EvenlySpaced = True     '各栏平均
End With
With Selection.PageSetup              '页面设置
.TopMargin = CentimetersToPoints(2)      '顶端边距
.BottomMargin = CentimetersToPoints(2)   '底端边距
.LeftMargin = CentimetersToPoints(3)     '左边距
.RightMargin = CentimetersToPoints(3)    '右边距
.PageWidth = CentimetersToPoints(18.2)   '页面宽度
.PageHeight = CentimetersToPoints(25.7)  '页面高度
End With
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader   '进入页眉页脚编辑状态
With ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range  '第1节主页眉
.Text = "VBA实现WORD自动排版"
.Font.Size = 10.5
.Font.Name = "宋体"
End With
ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).PageNumbers.Add  '第1节主页脚加页码
ActiveDocument.Save
ActiveDocument.Close
filename = Dir              '下个word
Loop Until filename = ""    '文件空则退出遍历
End Sub