Sub 自动排版word()
Dim filepath, filename, paragraphcount, myrange filepath = ThisDocument.Path& \ '当前路径 filename = Dir(filepath& \ '遍历文件 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.SetCountnumcolumns:=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 = \实现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