VBA宏实现Word论文自动排版
一、灵感与动机
作为一名即将毕业的大四学生，不仅经历了设计、编写系统的痛苦，还经历了撰写论文的烦恼，尤其是最后论文排版阶段，非常的繁琐和费时。所以我就希望可以有一个自动排版的“脚本”，一开始认为可以通过Python完成（因为Python属实强大），但经过大量的搜索和学习，我发现Office中给用户提供了一个宏语言，用户可以自己通过编码完成除现有功能外的其他功能。其默认支持VB，此外还有JS和Python也可以进行下载并切换开发环境。
二、现状与开发过程
在开发的过程中，也是遇到了很多很多困难。最重要的可能还是我还是太菜了ヽ(ー_ー)ノ，目前VBA宏的编写对Excel的操做更加实用和方便，所以网络资源中基本都是Excel的教程学习。导致关于Word中使用的VB操做的案例和教程微乎其微，只能自己通过摸索、阅读文档和让ChatGPT帮忙。给也想练习的小伙伴一些建议吧，少走弯路：
（1）一开始我参考的开发文档是VB的，如果你VB不好可以参考，地址：Visual Basic 文档 - 入门、教程、参考。 | Microsoft Learn
但如果是word中的VBA开发文档需要参考Microsoft提供的，地址：Visual Basic for Applications (VBA) 的 Word 对象模型 | Microsoft Learn
（2）AI不是全部，不能给你提供直接搬来就能用的代码，需要你辨识和改变，这才是AI在帮助你编码中最正确的用法。
三、总体效果
使用VB的窗体与宏功能建立联系，目前已实现的功能：
（1）目录样式
（2）1、2、3...级标题样式
（3）正文样式
（4）图注、表注样式
（5）表格样式
（6）页面设置样式
（7）摘要（中英）样式，包括关键词样式
四、部分功能实现
（1）修改标题样式（1、2、3...级标题）
以1级标题为例，首先找到类型为“标题 1”的样式段落，再修改其具体样式，如加粗、下划线、倾斜、行距、段前段后等。实现代码如下：
Sub FormatHeading2() '修改1级标题
Dim p As Paragraph
For Each p In ActiveDocument.Paragraphs
If p.Style = ActiveDocument.styles("标题 1") Then
p.Range.Font.Bold = True
p.Range.Font.Italic = True '设置倾斜
p.Range.Font.Underline = wdUnderlineSingle '设置下划线（单下划线）
p.Range.Font.Size = 15
p.Range.Font.name = "宋体"
p.Range.ParagraphFormat.Alignment = wdAlignParagraphRight
p.Range.ParagraphFormat.spaceBefore = 20
p.Range.ParagraphFormat.spaceAfter = 10
p.Range.ParagraphFormat.LineSpacingRule = wdLineSpaceSingle '单倍行距
p.Range.ParagraphFormat.CharacterUnitFirstLineIndent = 0
p.Range.ParagraphFormat.FirstLineIndent = CentimetersToPoints(0)
End If
Next p
End Sub其他更多详细的属性可自行查阅开发文档。
（2）修改目录内容样式
对于目录中不同级别的标题的样式会存在差异，我查找并修改样式的过程是，先找到所有标题的名称，不同级别放入不同数组中，在每个数组遍历寻找第一次出现的段落修改其样式。注意注意：目录中的文本属于超链接文本！实现代码如下（以修改目录中1级标题为例）：
Sub updateDirectoryContentOneStyle() '注意超链接文本问题
Dim p As Paragraph
Dim one() As String
Dim oneCount As Integer
Dim i As Integer
For Each p In ActiveDocument.Paragraphs
If p.Style = ActiveDocument.styles("标题 1") Then
ReDim Preserve one(oneCount) '扩展一级标题数组
one(oneCount) = p.Range.text
oneCount = oneCount + 1
End If
Next p
'输出数组中保存的标题内容
For i = 0 To UBound(one)
Dim myRange As Range
Dim myStyle As Style
Set myRange = ActiveDocument.Content
myRange.Find.Execute FindText:=one(i), Forward:=True '查找
If myRange.Find.Found = True Then
With myRange
.Font.Bold = False
.Font.name = "宋体"
.Font.Size = 14
End With
End If
Next
End Sub（3）查找特定文本并修改其样式
本文以查找“关键词”三字为例。使用Find关键字进行查找，找到后修改其样式即可。更多的详细属性请参考开发文档，实现代码如下：
Sub findText()
Set myRange = ActiveDocument.Content
myRange.Find.Execute FindText:="关键词", Forward:=True
If myRange.Find.Found = True Then
With myRange
.Font.Bold = False
.ParagraphFormat.Alignment = wdAlignParagraphLeft '左对齐
.Font.Color = wdColorBlack
.Font.name = "黑体"
.Font.Size = 14
.ParagraphFormat.PageBreakBefore = False
.ParagraphFormat.CharacterUnitFirstLineIndent = 0 '去除首行缩进
.ParagraphFormat.FirstLineIndent = CentimetersToPoints(0)
End With
End If
End Sub（4）表格样式
修改表格样式，可以查阅开发文档与网络资源。我也参考了AI的一些代码。实现代码如下（最基本的不加样式的表格）：
Sub execlOperate() '表格样式操作
Application.ScreenUpdating = False '关闭屏幕刷新
Application.DisplayAlerts = False
On Error Resume Next '忽略错误
Dim mytable As Table, i As Long
If Selection.Information(wdWithInTable) = True Then i = 1
For Each mytable In ActiveDocument.Tables
If i = 1 Then Set mytable = Selection.Tables(1)
With mytable
'取消底色
.Shading.ForegroundPatternColor = wdColorAutomatic
.Shading.BackgroundPatternColor = wdColorAutomatic
Options.DefaultHighlightColorIndex = wdNoHighlight
.Range.HighlightColorIndex = wdNoHighlight
.Style = "表格主题"
'单元格边距
.TopPadding = PixelsToPoints(0, True) '设置上边距为0
.BottomPadding = PixelsToPoints(0, True) '设置下边距为0
.LeftPadding = PixelsToPoints(0, True) '设置左边距为0
.RightPadding = PixelsToPoints(0, True) '设置右边距为0
.Spacing = PixelsToPoints(0, True) '允许单元格间距为0
.AllowPageBreaks = True '允许断页
'.AllowAutoFit = True '允许自动调整尺寸
'设置边框
.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
.Borders(wdBorderRight).LineStyle = wdLineStyleNone
.Borders(wdBorderTop).LineStyle = wdLineStyleNone
.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
.Borders(wdBorderTop).LineStyle = wdLineStyleThinThickMedGap
.Borders(wdBorderTop).LineWidth = wdLineWidth2pt
.Borders(wdBorderBottom).LineStyle = wdLineStyleThickThinMedGap
.Borders(wdBorderBottom).LineWidth = wdLineWidth225pt
With .Rows
.WrapAroundText = False '取消文字环绕
.Alignment = wdAlignRowCenter '表水平居中 wdAlignRowLeft '左对齐
.AllowBreakAcrossPages = False '不允许行断页
.HeightRule = wdRowHeightExactly '行高设为最小值 wdRowHeightAuto '行高设为自动
.Height = CentimetersToPoints(0) '上面缩进量为0
.LeftIndent = CentimetersToPoints(0) '左面缩进量为0
End With
With .Range
With .Font '字体格式
.name = "宋体"
.name = "Times New Roman"
.Color = wdColorAutomatic '自动字体颜色
.Size = 12
.Kerning = 0
.DisableCharacterSpaceGrid = True
End With
With .ParagraphFormat '段落格式
.CharacterUnitFirstLineIndent = 0 '取消首行缩进
.FirstLineIndent = CentimetersToPoints(0) '取消首行缩进
.LineSpacingRule = wdLineSpaceSingle '单倍行距 wdLineSpaceExactly '行距固定值
'.LineSpacing = 20 '设置行间距为20磅，配合行距固定值
.Alignment = wdAlignParagraphCenter '单元格水平居中
.AutoAdjustRightIndent = False
.DisableLineHeightGrid = True
End With
.Cells.VerticalAlignment = wdCellAlignVerticalCenter '单元格垂直居中
End With
'设置首行格式
.Cell(1, 1).Select ' 选中第一个单元格
With Selection
.SelectRow '选中当前行
Selection.Rows.HeadingFormat = wdToggle '自动标题行重复
.Range.Font.Bold = False '表头加粗黑体
.Shading.ForegroundPatternColor = wdColorAutomatic '首行自动颜色
'.Shading.BackgroundPatternColor = -603923969 '首行底纹填充
End With
'自动调整表格
.Columns.PreferredWidthType = wdPreferredWidthAuto
.AutoFitBehavior (wdAutoFitContent) '根据内容调整表格
.AutoFitBehavior (wdAutoFitWindow) '根据窗口调整表格
End With
If i = 1 Then Exit For
Next
Err.Clear: On Error GoTo 0 '恢复错误捕捉
Application.DisplayAlerts = True '开启提示
Application.ScreenUpdating = True '开启屏幕刷新
End Sub（5）修改图注样式（表注同理）
修改图注的样式，我的思路是查找所有的图片并获取图片的上一段文本，修改其样式。修改表注同理，实现代码如下。
注：代码中使用了InlineShape库，只能查找Word文档中样式为嵌入式的图片。
Sub GetAllImageNextLineText() '修改所有图注的样式
Dim shp As InlineShape
Dim nextLine As Range
For Each shp In ActiveDocument.InlineShapes
If shp.Type = wdInlineShapePicture Then
Set para = shp.Range.Paragraphs(1)
Set nextPara = para.Next
If Not nextPara Is Nothing Then
'修改下一行文本的样式
With nextPara.Range
.ParagraphFormat.Alignment = wdAlignParagraphCenter '文本居中
.ParagraphFormat.LineSpacingRule = wdLineSpaceSingle '行距
.Font.name = "黑体" '字体名称
.Font.Size = 12 '字体大小
.ParagraphFormat.CharacterUnitFirstLineIndent = 0
.ParagraphFormat.FirstLineIndent = CentimetersToPoints(0)
End With
End If
End If
Next shp
End Sub（6）页面设置
这里就罗列的一些常用的页面设置方法，仅供参考和copy。更多详细的属性可自行查阅开发文档。
代码如下：
Sub installPage() '修改页面设置
Dim doc As Document
Set doc = ActiveDocument
With doc.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientPortrait '页面方向为纵向
.topMargin = CentimetersToPoints(3.3) '上边距
.bottomMargin = CentimetersToPoints(3.3) '下边距
.LeftMargin = CentimetersToPoints(2.8) '左边距
.RightMargin = CentimetersToPoints(2.6) '右边距
.Gutter = CentimetersToPoints(0) '装订线
.HeaderDistance = CentimetersToPoints(1.5) '页眉
.FooterDistance = CentimetersToPoints(1.75) '页脚
.PageWidth = CentimetersToPoints(21) '纸张宽
.PageHeight = CentimetersToPoints(29.7) '纸张高
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage '节的起始位置：新建页
.OddAndEvenPagesHeaderFooter = False '不勾选“奇偶页不同”
.DifferentFirstPageHeaderFooter = False '不勾选“首页不同”
.VerticalAlignment = wdAlignVerticalTop '页面垂直对齐方式为“顶端对齐”
.SuppressEndnotes = False '不隐藏尾注
.MirrorMargins = False '不设置首页的内外边距
.TwoPagesOnOne = False
.BookFoldPrinting = False
.GutterPos = wdGutterPosLeft '装订线位于左侧
.LayoutMode = wdLayoutModeLineGrid '版式模式为“只指定行网格”
End With
End Sub到此，所有分享结束了，希望上述经历和代码可以帮助你们。还有更多功能和方法值得我和你们去研究，感谢浏览。有其他好的问题和经验可以在评论区留言或私信我。٩(๑❛ᴗ❛๑)۶