一個(gè)簡(jiǎn)單的宏實(shí)現(xiàn)一鍵排版（整理復(fù)盤）

[TOC]

宏和VBA的區(qū)別

  • 宏是一個(gè)或多個(gè)指令的集合，控制word執(zhí)行一連串的操作
  • VBA是高級(jí)語言，通過面向?qū)ο蟮姆椒▉硗瓿珊瓴荒芡瓿傻墓ぷ鳌?/li>
  • VBA宏會(huì)被VB編輯器記錄為一個(gè)VBA過程

一鍵排版宏舉例

Sub typeset()
'
' typeset 宏
' Author : 李佳成
' Time : 2018.5.1
'
'
'   清除格式
    Selection.WholeStory
    Selection.ClearParagraphDirectFormatting
    On Error Resume Next
    
'   首行縮進(jìn)
    
    With Selection.ParagraphFormat
 
        .LeftIndent = CentimetersToPoints(0)
 
        .RightIndent = CentimetersToPoints(0)
 
        .SpaceBefore = 0
 
        .SpaceBeforeAuto = False
 
        .SpaceAfter = 0
 
        .SpaceAfterAuto = False
 
        .LineSpacingRule = wdLineSpaceSingle
 
        .Alignment = wdAlignParagraphJustify
 
        .WidowControl = False
 
        .KeepWithNext = False
 
        .KeepTogether = False
 
        .PageBreakBefore = False
 
        .NoLineNumber = False
 
        .Hyphenation = True
 
        .FirstLineIndent = CentimetersToPoints(0)
 
        .OutlineLevel = wdOutlineLevelBodyText
 
        .CharacterUnitLeftIndent = 0
 
        .CharacterUnitRightIndent = 0
 
        .CharacterUnitFirstLineIndent = 2
 
        .LineUnitBefore = 0
 
        .LineUnitAfter = 0
 
        .MirrorIndents = False
 
        .TextboxTightWrap = wdTightNone
 
        .AutoAdjustRightIndent = True
 
        .DisableLineHeightGrid = False
 
        .FarEastLineBreakControl = True
 
        .WordWrap = True
 
        .HangingPunctuation = True
 
        .HalfWidthPunctuationOnTopOfLine = False
 
        .AddSpaceBetweenFarEastAndAlpha = True
 
        .AddSpaceBetweenFarEastAndDigit = True
 
        .BaseLineAlignment = wdBaselineAlignAuto
 
    End With
    
    
'   清除段落前后空格
    For a = 1 To ActiveDocument.Paragraphs.Count
    Set sutRng = ActiveDocument.Paragraphs(a).Range
    sutRng.MoveEnd wdCharacter, -1
    sutRng.Text = Trim(sutRng.Text)
    sutRng.MoveEnd wdCharacter, 1
    ActiveDocument.Paragraphs(a).Range.Text = sutRng.Text
    Next a
    
'   清除空行，空格
    
    Dim i As Paragraph, n As Long
    Application.ScreenUpdating = False
    For Each i In ActiveDocument.Paragraphs
    If Len(i.Range) = 1 Then
    i.Range.Delete
    n = n + 1
    End If
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
    .Text = "　"
    .Replacement.Text = ""
    .Wrap = wdFindContinue
    End With
    With Selection.Find
    .Text = "vbTab"
    .Replacement.Text = ""
    .Wrap = wdFindContinue
    End With
    With Selection.Find
    .Text = " "
    .Replacement.Text = ""
    .Wrap = wdFindContinue
    End With
    With Selection.Find
        .Text = "^t"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Next
    Application.ScreenUpdating = True
    Options.AutoFormatAsYouTypeDeleteAutoSpaces = True
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = " "
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    Selection.WholeStory
    With ActiveDocument.Styles(wdStyleNormal).Font
        If .NameFarEast = .NameAscii Then
            .NameAscii = ""
        End If
        .NameFarEast = ""
    End With
'   設(shè)置頁(yè)面
    With Selection.PageSetup
        .LineNumbering.Active = False
        .Orientation = wdOrientPortrait
        .TopMargin = CentimetersToPoints(2.54)
        .BottomMargin = CentimetersToPoints(1.4)
        .LeftMargin = CentimetersToPoints(2.2)
        .RightMargin = CentimetersToPoints(1.3)
        .Gutter = CentimetersToPoints(0)
        .HeaderDistance = CentimetersToPoints(1.3)
        .FooterDistance = CentimetersToPoints(2)
        .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
        .BookFoldRevPrinting = False
        .BookFoldPrintingSheets = 1
        .GutterPos = wdGutterPosLeft
        .CharsLine = 39
        .LinesPage = 32
        .LayoutMode = wdLayoutModeGrid
    End With
    

        
'   設(shè)置段落
    If (ActiveDocument.Paragraphs.Count >= 1) Then
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
    Selection.MoveLeft unit:=wdCharacter, Count:=1
    Selection.MoveDown unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    Selection.Font.Name = "宋體"
    Selection.Font.Bold = wdToggle
    Selection.Font.Size = 22
    Selection.MoveRight unit:=wdCharacter, Count:=1
    End If
    
    If (ActiveDocument.Paragraphs.Count >= 2) Then
    Selection.MoveDown unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    Selection.Font.Name = "宋體"
    Selection.Font.Bold = wdToggle
    Selection.Font.Size = 22
    Selection.MoveRight unit:=wdCharacter, Count:=1
    End If
    
    If (ActiveDocument.Paragraphs.Count >= 3) Then
    Selection.MoveDown unit:=wdParagraph, Count:=ActiveDocument.Paragraphs.Count - 2, Extend:=wdExtend
    Selection.Font.Name = "GB2312"
    Selection.Font.Size = 16
    Selection.MoveRight unit:=wdCharacter, Count:=1
    End If
    
'   加空段落
    ActiveDocument.Paragraphs(2).Range.InsertAfter Chr(13)

'   關(guān)鍵字居中或加粗
    Dim arr_sum(), arr(14), m As Integer, q
    arr(0) = "宣布法庭紀(jì)律"
    arr(1) = "宣布開庭"
    arr(2) = "法庭調(diào)查"
    arr(3) = "最后陳述"
    arr(4) = "法庭調(diào)解"
    arr(5) = "當(dāng)庭宣判"
    arr(6) = "宣布法庭組成人員和書記員名單"
    arr(7) = "宣布法庭組成人員和書記員名單"
    arr(8) = "告知當(dāng)事人有關(guān)的訴訟權(quán)利和義務(wù)"
    arr(9) = "訴稱部分"
    arr(10) = "答辯部分"
    arr(11) = "法庭歸納爭(zhēng)議焦點(diǎn)"
    arr(12) = "當(dāng)事人舉證質(zhì)證部分"
    arr(13) = "原告舉證部分"
    arr(14) = "被告舉證部分"
    For m = 0 To 14
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = arr(m)
        .Replacement.Text = ""
        .Format = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    
    s = ActiveDocument.Range(0, Selection.End).Paragraphs.Count
    q = ActiveDocument.Paragraphs(s).Range.Characters.Count
    Selection.Find.Execute
    If Selection.Font.Bold = False Then
        Selection.Font.Bold = wdToggle
    End If
    If m <= 5 Then
    Selection.Font.Size = 18
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    End If
    
  
    Next
    
    
'   案由，案號(hào)替換格式
    
    Set myRangeb = ActiveDocument.Content
    myRangeb.Find.ClearFormatting
    Dim b As Long
    b = myRangeb.End
    Do While myRangeb.Find.Execute("案號(hào)")
    myRangeb.Select
    myRangeb.Text = "案    號(hào)"
    myRangeb.Start = myRangeb.Start + Len(myRangeb.Find.Text)
    myRangeb.End = b
    Loop
        
    
    
    
    Set myRangea = ActiveDocument.Content
    myRangea.Find.ClearFormatting
    Dim f As Long
    f = myRangea.End
    Do While myRangea.Find.Execute("案由")
    myRangea.Select
    myRangea.Text = "案    由"
    myRangea.Start = myRangea.Start + Len(myRangea.Find.Text)
    myRangea.End = f
    Loop
    
'   關(guān)鍵字用縮進(jìn)方式對(duì)齊
    Dim arr2(7), j As Integer
    arr2(0) = "人民陪審員："
    arr2(1) = "審判員："
    arr2(2) = "書記員："
    arr2(3) = "有無間斷："
    arr2(4) = "其他說明："
    arr2(5) = "結(jié)束時(shí)間："
    arr2(6) = "原告方："
    arr2(7) = "被告方："
    For j = 0 To 7
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = arr2(j)
        .Replacement.Text = ""
        .Format = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
    Selection.ParagraphFormat.LeftIndent = 165
    If j <= 2 Then
    Selection.ParagraphFormat.LeftIndent = 110
    End If
    If j > 5 Then
    Selection.ParagraphFormat.LeftIndent = 330
    End If
    Next
    

End Sub

完成目標(biāo)

  1. 設(shè)置標(biāo)題及前三段的字體，字號(hào)
  2. 首行縮進(jìn)
  3. 去除多余空格，制表符，空段
  4. 對(duì)特殊要求字符進(jìn)行個(gè)別縮進(jìn)
  5. 替換字符
  6. 頁(yè)面設(shè)置：頁(yè)邊距，行距，頁(yè)眉頁(yè)腳等。

防坑指南

  1. 清除格式要求：盡量不要用剪切純文本方式來清除格式
selection.WholeStory
Selection.ClearParagraphDirectFormatting
  1. 程序執(zhí)行是有順序的，特別在word中，光標(biāo)的位置隨著程序的執(zhí)行要注意位置，例如查找字符的時(shí)候，特別需要注意。
  2. 關(guān)鍵字設(shè)置格式，要注意數(shù)組越界。
?著作權(quán)歸作者所有,轉(zhuǎn)載或內(nèi)容合作請(qǐng)聯(lián)系作者
【社區(qū)內(nèi)容提示】社區(qū)部分內(nèi)容疑似由AI輔助生成，瀏覽時(shí)請(qǐng)結(jié)合常識(shí)與多方信息審慎甄別。
平臺(tái)聲明：文章內(nèi)容（如有圖片或視頻亦包括在內(nèi)）由作者上傳并發(fā)布，文章內(nèi)容僅代表作者本人觀點(diǎn)，簡(jiǎn)書系信息發(fā)布平臺(tái)，僅提供信息存儲(chǔ)服務(wù)。

相關(guān)閱讀更多精彩內(nèi)容

友情鏈接更多精彩內(nèi)容