Word-vba-自动排版.docxVIP

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