word“一键排版”插件升级了,还在用的小伙伴,赶快更新了

 Sub 规范()'    Call 删除特殊字符  '调用子程序     Selection.HomeKey Unit:=wdStory    ' 定义所有查找替换配置    Dim 配置 As Collection    Set 配置 = New Collection    ' 添加所有查找替换配置    ' 格式: Array(查找文本, 替换文本, 是否使用通配符, 是否向前查找, 是否MatchByte)    ' 1. 中文引号规范化    配置.Add Array("[""&""&" & ChrW(8221) & "&" & ChrW(8221) & "&" & ChrW(8220) & _        "](*)[""&" & ChrW(8220) & "&" & ChrW(8220) & "&" & ChrW(8221) & _        "&" & ChrW(8220) & "]", " " & ChrW(8220) & "\1" & ChrW(8221), True, False, True)    ' 2-3. 删除空格    配置.Add Array(" ", "", False, True, False)    配置.Add Array("  ", "", False, True, False)    ' 4-5. 段落标记处理    配置.Add Array("^13{1,}", "^32", True, True, False)    配置.Add Array("^32", "^p", False, True, False)    ' 6. 单引号规范化    配置.Add Array("['&'&''&'](*)['&'&''&']", "'\1'", True, True, False)    ' 7. 行分隔符转换    配置.Add Array("^l", "^13", True, True, False)    ' 8. 删除多个空格    配置.Add Array("^32{1,}", "", True, True, False)    ' 9-13. 标点符号中文化    配置.Add Array(",", "，", True, True, False)    配置.Add Array("(?[!0-9]).(*)", "\1。\2", True, True, False)    配置.Add Array("?", "？", False, True, False)    配置.Add Array("!", "！", False, True, False)    配置.Add Array(":", "：", False, True, False)    配置.Add Array(";", "；", False, True, False)    ' 14. 序号规范化    配置.Add Array("(<[1-9]{1,})、(?)", "\1.\2", True, True, False)    ' 执行所有查找替换    Dim 项目 As Variant    For Each 项目 In 配置        执行查找替换操作 项目    Next 项目    MsgBox "文章中的标点、段落等已规范成功，请点击“确定”。", 0, "一键排版"End Sub' 通用的查找替换执行函数Sub 执行查找替换操作(配置项 As Variant)    Dim 查找文本 As String, 替换文本 As String    Dim 使用通配符 As Boolean, 向前查找 As Boolean, 匹配字节 As Boolean    查找文本 = 配置项(0)    替换文本 = 配置项(1)    使用通配符 = 配置项(2)    向前查找 = 配置项(3)    匹配字节 = 配置项(4)    Selection.Find.ClearFormatting    Selection.Find.Replacement.ClearFormatting    With Selection.Find        .text = 查找文本        .Replacement.text = 替换文本        .Forward = 向前查找        .Wrap = wdFindContinue        .Format = False        .MatchWildcards = 使用通配符        If 匹配字节 Then .MatchByte = True    End With    Selection.Find.Execute Replace:=wdReplaceAllEnd SubSub 删除特殊字符()    Dim 特殊字符 As Variant    Dim i As Integer    ' 定义要删除的字符数组    特殊字符 = Array("*", "#", "-")    Selection.HomeKey Unit:=wdStory    ' 循环删除每个特殊字符    For i = LBound(特殊字符) To UBound(特殊字符)        Selection.Find.ClearFormatting        Selection.Find.Replacement.ClearFormatting        With Selection.Find            .text = 特殊字符(i)            .Replacement.text = ""            .Forward = True            .Wrap = wdFindContinue            .Format = False            .MatchWildcards = False        End With        Selection.Find.Execute Replace:=wdReplaceAll    Next iEnd Sub

Sub 附件()    ' 检查是否有选中的内容    If Selection.Type = wdSelectionIP Then        MsgBox "请先选中需要排版的文字", vbExclamation        Exit Sub    End If    Application.ScreenUpdating = False   ' 1. 确保正文下方空一行（一个空行 = 两个段落标记）    Dim startPos As Long    startPos = Selection.Start    ' 如果选中的不是文档开头，检查前面的段落标记数量    If startPos > 1 Then        Dim paraMarkCount As Integer        paraMarkCount = 0        ' 向前统计连续的段落标记数量        Dim i As Long        i = 1        Do While startPos - i >= 0            Dim charAtPos As String            charAtPos = ActiveDocument.Range(startPos - i, startPos - i + 1).text            ' 检查是否是段落标记（Chr(13)）            If charAtPos = Chr(13) Then                paraMarkCount = paraMarkCount + 1                i = i + 1            Else                Exit Do            End If        Loop        ' 根据段落标记数量进行处理        Select Case paraMarkCount            Case 0                ' 没有段落标记，插入一个空行（两个段落标记）                Selection.InsertBefore vbCrLf & vbCrLf                startPos = startPos + 2            Case 1                ' 只有一个段落标记，再插入一个                Selection.InsertBefore vbCrLf                startPos = startPos + 1            Case 2                ' 正好两个段落标记，不做任何操作                ' （已经有空行了）            Case Else                ' 多于两个段落标记，删除多余的                Dim deleteCount As Integer                deleteCount = paraMarkCount - 2 ' 保留2个                For i = 1 To deleteCount                    ActiveDocument.Range(startPos - paraMarkCount - 1 + i, startPos - paraMarkCount + i).Delete                    startPos = startPos - 1                Next i        End Select    ElseIf startPos = 1 Then        ' 在文档开头，需要插入两个段落标记        Selection.InsertBefore vbCrLf & vbCrLf        startPos = startPos + 2    End If    ' 重新选中原来的内容    Selection.SetRange startPos, Selection.End    ' 2. 设置基本格式    With Selection        .Font.NameFarEast = "仿宋_GB2312"        .Font.NameAscii = "Times New Roman"        .Font.NameOther = "仿宋"        .Font.Size = 16 ' 3号字=16磅        .Font.Bold = False        With .ParagraphFormat            .LineSpacingRule = wdLineSpaceExactly            .LineSpacing = 28 ' 28磅行间距        End With    End With    ' 3. 设置缩进格式    Dim paraCount As Integer    paraCount = Selection.Paragraphs.Count    If paraCount >= 1 Then        ' 第一行：左侧缩进2字符，悬挂缩进3字符        Selection.Paragraphs(1).Format.CharacterUnitLeftIndent = 2        Selection.Paragraphs(1).Format.CharacterUnitFirstLineIndent = -3        ' 其他行：左缩进5字符        For i = 2 To paraCount            Selection.Paragraphs(i).Format.CharacterUnitLeftIndent = 5        Next i    End If    Application.ScreenUpdating = True    MsgBox "附件排版完成！", vbInformationEnd Sub

Sub 页面设置()    Dim a As String    ' 提示用户：若已插入页码（或不需要），点击“是”继续设置；若需要先插入页码，点击“否”退出。    a = MsgBox("请确认是否已插入页码（或不需要插入页码）。" & vbCrLf & _               "· 点击“是”将继续进行页面设置；" & vbCrLf & _               "· 点击“否”将退出宏，请先插入页码。", vbYesNo, "页面设置提示")    If a = vbYes Then    ' 用户点击“是”        With Selection.pageSetup            ' 关闭行号            .LineNumbering.Active = False            ' 纸张方向与大小            .Orientation = wdOrientPortrait            .pageWidth = CentimetersToPoints(21)      ' A4 宽 21 cm            .pageHeight = CentimetersToPoints(29.7)   ' A4 高 29.7 cm            ' 页边距（标准公文要求）            .TopMargin = CentimetersToPoints(3.7)     ' 上 3.7 cm            .BottomMargin = CentimetersToPoints(3.5)  ' 下 3.5 cm            .LeftMargin = CentimetersToPoints(2.8)    ' 左 2.8 cm            .RightMargin = CentimetersToPoints(2.6)   ' 右 2.6 cm            ' 装订线（通常为 0）            .Gutter = CentimetersToPoints(0)            .GutterPos = wdGutterPosLeft            ' 页眉/页脚距边界距离            .HeaderDistance = CentimetersToPoints(1.5)    ' 页眉 1.5 cm            .FooterDistance = CentimetersToPoints(2.5)    ' 页脚 2.5 cm            ' 节、页眉页脚设置            .SectionStart = wdSectionNewPage            .OddAndEvenPagesHeaderFooter = True   ' 奇偶页眉页脚不同            .DifferentFirstPageHeaderFooter = False ' 首页页眉页脚同其他页（可根据需要改为 True）            .MirrorMargins = True                 ' 对称页边距（双面打印）            ' 文档网格（每页 22 行，每行 28 字）            .LayoutMode = wdLayoutModeDefault     ' 排放文本时不使用网格            .LinesPage = 22                       ' 每页行数            .CharsLine = 28                       ' 每行字符数（对应三号仿宋）            ' 打印机纸盒（默认）            .FirstPageTray = wdPrinterDefaultBin            .OtherPagesTray = wdPrinterDefaultBin            ' 其他设置            .VerticalAlignment = wdAlignVerticalTop            .BookFoldPrintingSheets = 1           ' 如需 booklet 打印可调整        End With       '设置行间距为最小值28磅，比设为固定值更优化，能避免图像显示不全的问题。        With Selection.ParagraphFormat             .LineSpacingRule = wdLineSpaceAtLeast             .LineSpacing = 28        End With        MsgBox "页面设置已完成，符合《党政机关公文格式》（GB/T 9704-2012）标准。", vbInformation, "完成"    Else    ' 用户点击“否”        MsgBox "请先插入页码（建议页码位于页脚外侧，四号宋体阿拉伯数字），然后再运行本宏。", vbExclamation, "提示"        Exit Sub    End IfEnd Sub