【VB脚本备忘】【for WORD】政策与法条排版

很久以前，经常要对网上找的政策和法条排版后留存，排版很烦，曾经写了两段代码，省事不少，前期要用，找不到了。偶然翻到底稿，赶紧做个备份。

【法条】

***法条***
Sub TypeSet()
    Application.ScreenUpdating = False
    '------------------------------------------ 处理字符 ------------------------------------------
    ActiveDocument.Content.Find.Execute FindText:="(", ReplaceWith:="（", Replace:=wdReplaceAll
    ActiveDocument.Content.Find.Execute FindText:=")", ReplaceWith:="）", Replace:=wdReplaceAll
    ActiveDocument.Content.Find.Execute FindText:=" ", ReplaceWith:="", Replace:=wdReplaceAll
    ActiveDocument.Content.Find.Execute FindText:="　", ReplaceWith:="", Replace:=wdReplaceAll
    ActiveDocument.Content.Find.Execute FindText:=Chr(9), ReplaceWith:="", Replace:=wdReplaceAll
    ActiveDocument.Content.Find.Execute FindText:="[", ReplaceWith:="〔", Replace:=wdReplaceAll
    ActiveDocument.Content.Find.Execute FindText:="]", ReplaceWith:="〕", Replace:=wdReplaceAll
    '------------------------------------------ 删空白行 ------------------------------------------
    For p = ActiveDocument.Paragraphs.Count To 1 Step -1
        If Len(ActiveDocument.Paragraphs(p).Range) = 1 Then ActiveDocument.Paragraphs(p).Range.Delete
    Next
    '------------------------------------------ 定义字典 ------------------------------------------
    Dim D1 As Object
    Set D1 = CreateObject("scripting.dictionary")
    Dim n&
    For n = 1 To 250
        D1(n) = CChinese(n)
    Next
    '------------------------------------------ 定义字典 ------------------------------------------
'    Dim D2 As Object
'    Set D2 = CreateObject("scripting.dictionary")
'    For i = 1 To 40
'        D2(i) = CStr(i)
'    Next
    '----------------------------------------------------------------------------------------------
    Dim Pstr
    Pstr = ""
    '------------------------------------------ 一级标题 ------------------------------------------
    With ActiveDocument.Paragraphs(1).Range.Font
        .Size = 18
        .Name = "黑体"
        .Bold = True
    End With
    With ActiveDocument.Paragraphs(1).Range.ParagraphFormat
        .Alignment = wdAlignParagraphCenter         '对齐方式
        .OutlineLevel = wdOutlineLevel1             '大纲级别
        .CharacterUnitFirstLineIndent = 0           '首行缩进
        .LineSpacingRule = wdLineSpaceSingle        '行距（单位：网格倍数）
        .LineUnitBefore = 0                         '段前间距（单位：网格倍数）
        .LineUnitAfter = 1                          '段后间距（单位：网格倍数）
'''        .SpaceBefore = 0
'''        .SpaceAfter = 5
'''        .FirstLineIndent = CentimetersToPoints(0)
'        .LeftIndent = CentimetersToPoints(0)
'        .RightIndent = CentimetersToPoints(0)
'        .SpaceBeforeAuto = False
'        .SpaceAfterAuto = False
'        .WidowControl = True
'        .KeepWithNext = False
'        .KeepTogether = False
'        .PageBreakBefore = False
'        .NoLineNumber = False
'        .Hyphenation = True
'        .CharacterUnitLeftIndent = 0
'        .CharacterUnitRightIndent = 0
'        .MirrorIndents = False
'        .TextboxTightWrap = wdTightNone
'        .CollapsedByDefault = False
'        .AutoAdjustRightIndent = True
'        .DisableLineHeightGrid = False
'        .FarEastLineBreakControl = True
'        .WordWrap = True
'        .HangingPunctuation = True
'        .HalfWidthPunctuationOnTopOfLine = False
'        .AddSpaceBetweenFarEastAndAlpha = True
'        .AddSpaceBetweenFarEastAndDigit = True
'        .BaseLineAlignment = wdBaselineAlignAuto
    End With
'---------------------------------------------------------------------------------------------------------------
    For p = 2 To ActiveDocument.Paragraphs.Count
        Pstr = ""
        For i = 1 To D1.Count
            Pstr = ActiveDocument.Paragraphs(p)
            '------------------------------------------ 二级标题 ------------------------------------------
            If Pstr Like "第" & D1(i) & "章*" Then
                With ActiveDocument.Paragraphs(p)
                    m = InStr(.Range, "章")
                    .Range.Text = Left(.Range, m) & vbTab & Right(.Range, Len(.Range) - m)
                End With
                With ActiveDocument.Paragraphs(p).Range.Font
                    .Size = 15
                    .Name = "黑体"
                    .Bold = True
                End With
                With ActiveDocument.Paragraphs(p).Range.ParagraphFormat
                    .Alignment = wdAlignParagraphCenter         '对齐方式
                    .OutlineLevel = wdOutlineLevel2             '大纲级别
                    .CharacterUnitFirstLineIndent = 0           '首行缩进
                    .LineSpacingRule = wdLineSpaceSingle        '行距（单位：网格倍数）
                    .LineUnitBefore = 1                         '段前间距（单位：网格倍数）
                    .LineUnitAfter = 0.5                        '段后间距（单位：网格倍数）
'                    .LeftIndent = CentimetersToPoints(0)
'                    .RightIndent = CentimetersToPoints(0)
'                    .SpaceBefore = 5
'                    .SpaceBeforeAuto = False
'                    .SpaceAfter = 2.5
'                    .SpaceAfterAuto = False
'                    .WidowControl = True
'                    .KeepWithNext = False
'