VBA宏实现Word论文自动排版_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

        到此，所有分享结束了，希望上述经历和代码可以帮助你们。还有更多功能和方法值得我和你们去研究，感谢浏览。有其他好的问题和经验可以在评论区留言或私信我。٩(๑❛ᴗ❛๑)۶