[TOC]
宏和VBA的區(qū)別
- 宏是一個或多個指令的集合，控制word執(zhí)行一連串的操作
- VBA是高級語言挺身，通過面向?qū)ο蟮姆椒▉硗瓿珊瓴荒芡瓿傻墓ぷ鳌?/li>
- VBA宏會被VB編輯器記錄為一個VBA過程
一鍵排版宏舉例
Sub typeset()
'
' typeset 宏
' Author : 李佳成
' Time : 2018.5.1
'
'
' 清除格式
Selection.WholeStory
Selection.ClearParagraphDirectFormatting
On Error Resume Next
' 首行縮進
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è)置頁面
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) = "宣布法庭紀律"
arr(1) = "宣布開庭"
arr(2) = "法庭調(diào)查"
arr(3) = "最后陳述"
arr(4) = "法庭調(diào)解"
arr(5) = "當庭宣判"
arr(6) = "宣布法庭組成人員和書記員名單"
arr(7) = "宣布法庭組成人員和書記員名單"
arr(8) = "告知當事人有關(guān)的訴訟權(quán)利和義務(wù)"
arr(9) = "訴稱部分"
arr(10) = "答辯部分"
arr(11) = "法庭歸納爭議焦點"
arr(12) = "當事人舉證質(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
' 案由，案號替換格式
Set myRangeb = ActiveDocument.Content
myRangeb.Find.ClearFormatting
Dim b As Long
b = myRangeb.End
Do While myRangeb.Find.Execute("案號")
myRangeb.Select
myRangeb.Text = "案 號"
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)鍵字用縮進方式對齊
Dim arr2(7), j As Integer
arr2(0) = "人民陪審員："
arr2(1) = "審判員："
arr2(2) = "書記員："
arr2(3) = "有無間斷："
arr2(4) = "其他說明："
arr2(5) = "結(jié)束時間："
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
完成目標
- 設(shè)置標題及前三段的字體，字號
- 首行縮進
- 去除多余空格揖曾，制表符贩毕，空段
- 對特殊要求字符進行個別縮進
- 替換字符
- 頁面設(shè)置：頁邊距悯许，行距，頁眉頁腳等耳幢。
防坑指南
- 清除格式要求：盡量不要用剪切純文本方式來清除格式
selection.WholeStory
Selection.ClearParagraphDirectFormatting
- 程序執(zhí)行是有順序的岸晦，特別在word中，光標的位置隨著程序的執(zhí)行要注意位置，例如查找字符的時候，特別需要注意擒悬。
- 關(guān)鍵字設(shè)置格式氏淑，要注意數(shù)組越界。
