还在文档格式上挨骂？教你VBA一键设置公文格式

Option Explicit
Sub ResetAndCreateGovStyles()
    On Error GoTo ErrorHandler
    Application.ScreenUpdating = False
    ' 彻底删除所有非系统样式
    DeleteAllCustomStyles
    ' 设置页面布局（GB/T 9704-2012标准）
    With ActiveDocument.PageSetup
        .PaperSize = wdPaperA4
        .TopMargin = CentimetersToPoints(3.7)
        .BottomMargin = CentimetersToPoints(3.5)
        .LeftMargin = CentimetersToPoints(2.8)
        .RightMargin = CentimetersToPoints(2.6)
        .HeaderDistance = CentimetersToPoints(1.5)
        .FooterDistance = CentimetersToPoints(2.8)
        .DifferentFirstPageHeaderFooter = msoFalse
        .OddAndEvenPagesHeaderFooter = True
        .LayoutMode = wdLayoutModeLineGrid
        .LinesPage = 22
        .CharsLine = 28
    End With
    ' 强制创建新样式（即使存在同名样式）
    CreateStyleForce "正文样式", "仿宋", 16, wdAlignParagraphJustify, 28.9, 0, "仿宋_GB2312"
    CreateStyleForce "标题样式", "方正小标宋简体", 22, wdAlignParagraphCenter, 28.9, 0, "方正小标宋_GBK", "小标宋"
    CreateStyleForce "副标题样式", "楷体", 16, wdAlignParagraphCenter, 28.9, 0, "楷体_GB2312"
    CreateStyleForce "一级标题", "黑体", 16, wdAlignParagraphLeft, 28.9, 0
    CreateStyleForce "二级标题", "楷体", 16, wdAlignParagraphLeft, 28.9, 0, "楷体_GB2312"
    CreateStyleForce "三级标题", "仿宋", 16, wdAlignParagraphLeft, 28.9, 0, "仿宋_GB2312"
    CreateStyleForce "四级标题", "仿宋", 16, wdAlignParagraphLeft, 28.9, 0, "仿宋_GB2312", , True
    ' 设置正文特殊格式（首行缩进2字符）
    With ActiveDocument.Styles("正文").ParagraphFormat
        .CharacterUnitFirstLineIndent = 2  ' 使用字符单位确保兼容性
    End With
    ' 将样式添加到样式库
    AddStylesToGallery
    ' 设置页码（符合GB/T 9704-2012）
    SetPageNumbers
    ' 应用正文样式到整个文档
    ActiveDocument.Range.style = ActiveDocument.Styles("正文")
    Application.ScreenUpdating = True
    MsgBox "公文样式已按GB/T 9704-2012标准创建！" & vbCrLf & _
           "请在'开始'选项卡的样式库中查看。", _
           vbInformation, "公文格式设置"
    Exit Sub
ErrorHandler:
    Application.ScreenUpdating = True
    MsgBox "发生错误: " & Err.Description & vbCrLf & _
           "错误代码: " & Err.Number, vbCritical, "错误"
End Sub
' 将样式添加到样式库的关键函数
Sub AddStylesToGallery()
    Dim styleNames As Variant
    Dim i As Integer
    Dim style As style
    Dim priorityOrder As Variant
    ' 需要添加到样式库的样式列表及显示优先级
    styleNames = Array("标题", "副标题", "一级标题", "二级标题", "三级标题", "四级标题", "正文")
    priorityOrder = Array(1, 2, 3, 4, 5, 6, 7)  ' 优先级值越小显示越靠前
    For i = LBound(styleNames) To UBound(styleNames)
        On Error Resume Next
        Set style = ActiveDocument.Styles(styleNames(i))
        If Not style Is Nothing Then
            ' 关键设置：将样式添加到快速样式库
            style.QuickStyle = True
            ' 正确设置优先级（1-9999，值越小优先级越高）
            style.Priority = priorityOrder(i)
            ' 确保样式在库中可见
            style.Visibility = True
            style.UnhideWhenUsed = True
        End If
    Next i
    ' 刷新样式库
    ActiveDocument.UpdateStyles
End Sub
Sub DeleteAllCustomStyles()
    Dim s As style
    Dim stylesToKeep As Variant
    Dim i As Integer
    ' 扩展系统内置样式白名单（不删除）
    stylesToKeep = Array("Normal", "默认段落字体", "页眉", "页脚", "超链接", _
                         "标题1", "标题2", "标题3", "标题4", "标题5", _
                         "标题6", "标题7", "标题8", "标题9", "目录")
    ' 删除所有非内置样式
    For Each s In ActiveDocument.Styles
        If Not s.BuiltIn Then
            On Error Resume Next  ' 防止删除失败导致中断
            s.Delete
        End If
    Next s
    ' 重置内置样式（保留白名单）
    For Each s In ActiveDocument.Styles
        If s.BuiltIn Then
            If UBound(Filter(stylesToKeep, s.NameLocal)) < 0 Then
                On Error Resume Next
            End If
        End If
    Next s
End Sub
Sub CreateStyleForce(styleName As String, primaryFont As String, fontSize As Single, _
                    alignment As WdParagraphAlignment, lineSpacing As Single, _
                    spaceBefore As Single, Optional altFont1 As String = "", _
                    Optional altFont2 As String = "", Optional bold As Boolean = False)
    Dim style As style
    Dim fontList As Variant
    Dim i As Integer
    ' 构建字体回退列表
    fontList = Array(primaryFont, altFont1, altFont2, "宋体")
    ' 确保样式不存在
    On Error Resume Next
    ActiveDocument.Styles(styleName).Delete
    On Error GoTo 0
    ' 创建新样式
    Set style = ActiveDocument.Styles.Add(styleName, wdStyleTypeParagraph)
    ' 智能字体回退机制
    With style.Font
        For i = LBound(fontList) To UBound(fontList)
            If fontList(i) <> "" Then
                .Name = fontList(i)
                If .Name = fontList(i) Then Exit For  ' 字体存在则使用
            End If
        Next i
        .Size = fontSize
        .bold = bold
        .Italic = False
    End With
    ' 设置段落格式
    With style.ParagraphFormat
        .alignment = alignment
        .lineSpacingRule = wdLineSpaceExactly
        .lineSpacing = lineSpacing
        .spaceBefore = spaceBefore
        .SpaceAfter = 0
        .LeftIndent = 0
        .RightIndent = 0
    End With
End Sub
Sub SetPageNumbers()
    Dim oSec As Section
    Dim oFooter As HeaderFooter
    For Each oSec In ActiveDocument.Sections
        ' 设置页码格式（符合GB/T 9704-2012）
        With oSec.Footers(wdHeaderFooterPrimary).PageNumbers
            .NumberStyle = wdPageNumberStyleArabic
            .RestartNumberingAtSection = False
        End With
        With oSec.Footers(wdHeaderFooterEvenPages).PageNumbers
            .NumberStyle = wdPageNumberStyleArabic
            .RestartNumberingAtSection = False
        End With
        ' 设置奇数页页脚（右对齐）
        Set oFooter = oSec.Footers(wdHeaderFooterPrimary)
        With oFooter
            .LinkToPrevious = False
            .Range.Text = ""
            .Range.ParagraphFormat.alignment = wdAlignParagraphRight
            .PageNumbers.Add PageNumberAlignment:=wdAlignPageNumberRight, FirstPage:=False
        End With
        ' 设置偶数页页脚（左对齐）
        Set oFooter = oSec.Footers(wdHeaderFooterEvenPages)
        With oFooter
            .LinkToPrevious = False
            .Range.Text = ""
            .Range.ParagraphFormat.alignment = wdAlignParagraphLeft
            .PageNumbers.Add PageNumberAlignment:=wdAlignPageNumberLeft, FirstPage:=False
        End With
        ' 统一设置页码格式
        For Each oFooter In oSec.Footers
            With oFooter.Range
                .Font.Name = "宋体"
                .Font.Size = 14  ' 4号字
                ' 标准要求：单页码右空一字，双页码左空一字
                If oFooter.Index = wdHeaderFooterPrimary Then
                    .ParagraphFormat.RightIndent = .Font.Size * 1.5  ' 1字符宽度
                Else
                    .ParagraphFormat.LeftIndent = .Font.Size * 1.5  ' 1字符宽度
                End If
            End With
        Next oFooter
    Next oSec
End Sub