Word-vba-自动排版教学文案

精品文档

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.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 = \实现WORD自动排版\

.Font.Size = 10.5

.Font.Name = \宋体\ End With

ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).PageNumbers.Add '第1节主页脚加页码

ActiveDocument.Save

ActiveDocument.Close

filename = Dir

Loop Until filename = \End Sub

精品文档

'下个word '文件空则退出遍历