1

Sub typeset()
'
' typeset 宏
'
'   调整格式
    Selection.WholeStory
    Selection.ClearParagraphDirectFormatting
    Set myRange = ActiveDocument.Range(Start:=0, End:=ActiveDocument.Characters.Count)
    myRange.Select
    myRange.Cut
    myRange.PasteAndFormat (wdFormatPlainText)
   Selection.WholeStory
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
    Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
    
'   首行缩进
    
    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 = 0
 
        .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
    
'   清除空行,空格
    
    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
    Next
    Application.ScreenUpdating = True
    Options.AutoFormatAsYouTypeDeleteAutoSpaces = True
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
    .Text = " "
    .Replacement.Text = ""
    .Wrap = wdFindContinue
    End With
    With Selection.Find
    .Text = " "
    .Replacement.Text = ""
    .Wrap = wdFindContinue
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
   
    



'   页脚 Start
    Set viewActive = ActiveDocument.ActiveWindow.ActivePane.View
    viewActive.SeekView = wdSeekCurrentPageFooter
    
    Selection.WholeStory
    Selection.TypeBackspace
    
    Selection.Font.Name = "宋体"
    Selection.Font.Size = 10
    
    Selection.Paragraphs.Alignment = wdAlignParagraphRight
    Selection.TypeText ("当事人签名")
    
    Dim wdUnit As WdUnits
    wdUnit = WdUnits.wdLine
    
    Dim nLineBegin, nLineEnd As Long
    Selection.HomeKey (wdUnit)
    nLineBegin = Selection.Start
    Selection.EndKey (wdUnit)
    nLineEnd = Selection.End
    
    Dim nLineCount As Long
    nLineCount = 48 - (nLineEnd - nLienStart)
    
   
    For n = 0 To nLineCount
        Selection.TypeText ("__")
    Next n
        
    Selection.Paragraphs.Alignment = wdAlignParagraphLeft
    viewActive.SeekView = wdSeekMainDocument
'   页脚 End

        Selection.WholeStory
    With ActiveDocument.Styles(wdStyleNormal).Font
        If .NameFarEast = .NameAscii Then
            .NameAscii = ""
        End If
        .NameFarEast = ""
    End With
    
    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 = 42
        .LinesPage = 32
        .LayoutMode = wdLayoutModeGrid
    End With
    

        
    
    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 = "宋体"
    Selection.Font.Size = 12
    
    
    
    
    
    Selection.MoveRight unit:=wdCharacter, Count:=1
    End If
    


End Sub

2

    Selection.Find.ClearFormatting '清除查找框格式
    Selection.Find.Replacement.ClearFormatting '清除替换框格式
    With Selection.Find
        .Text = "^l"
        .Replacement.Text = "^p"
        .Forward = True '向后搜索
        .Wrap = wdFindContinue
        .Format = False ' 不清除格式
        .MatchCase = False ' 匹配大小写
        .MatchWholeWord = False ' 整词匹配
        .MatchByte = False ' 全角
        .MatchWildcards = False '不勾选"使用通配符"
        .MatchSoundsLike = False ' 不匹配 同音词
        .MatchAllWordForms = False ' 不查找单词的所有形式
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    '将^p^p替换为^p
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^p^p"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    '将空格替换为正确的格式
     Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = " "
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    '设置页面布局
    With ActiveDocument.PageSetup
        .Orientation = wdOrientPortrait '页面方向为纵向
        .TopMargin = CentimetersToPoints(1.27) '上边距
        .BottomMargin = CentimetersToPoints(1.27) '下边距
        .LeftMargin = CentimetersToPoints(1.27) '左边距
        .RightMargin = CentimetersToPoints(1.27) '右边距
        .Gutter = CentimetersToPoints(0) '装订线0cm
        .HeaderDistance = CentimetersToPoints(1.5) '页眉
        .FooterDistance = CentimetersToPoints(1.75) '页脚
        .PageWidth = CentimetersToPoints(25) '纸张宽
        .PageHeight = CentimetersToPoints(35.4) '纸张高
        .SectionStart = wdSectionNewPage '节的起始位置:新建页
        .OddAndEvenPagesHeaderFooter = False '不勾选"奇偶页不同"
        .DifferentFirstPageHeaderFooter = False '不勾选"首页不同"
        .VerticalAlignment = wdAlignVerticalTop '页面垂直对齐方式为"顶端对齐"
        .SuppressEndnotes = False '不隐藏尾注
        .MirrorMargins = False '不设置首页的内外边距
        .BookFoldRevPrinting = False '不设置手动双面打印
        .BookFoldPrintingSheets = 1 '默认打印份数为1
        .GutterPos = wdGutterPosLeft '装订线位于左侧
        .LayoutMode = wdLayoutModeLineGrid '版式模式为"只指定行网格"
    End With
    '设置段落
    With ActiveDocument.Paragraphs
        .CharacterUnitFirstLineIndent = 2
        .Alignment = wdAlignParagraphLeft   '居左对齐
        .SpaceBefore = 0 '段前间距
        .SpaceBeforeAuto = False
        .SpaceAfter = 4 '段后间距
        .SpaceAfterAuto = False
        '.LineSpacingRule = wdLineSpaceExactly '单倍行距,可以自定义数值
        '必须注释这一行,否则图片变为悬浮格式
        .LineSpacing = 14 '行间距XX磅
        .WidowControl = -1 '孤行控制,可以控制tab键不必过长
        .KeepWithNext = 0 '与下段同页
        .KeepTogether = 0 '段中不分页
        .PageBreakBefore = 0 '段前分页
    End With
    '删除所有超链接书签和连接
        With ActiveDocument
                Dim myLink As Hyperlink
                Dim myBookmark As Bookmark
                Dim myField As Field
                For Each myLink In .Hyperlinks
                        'myLink.Delete '删除所有超链接
                Next myLink
                For Each myBookmark In .Bookmarks
                        myBookmark.Delete ''删除"链接"中的"书签"(灰色中括号标记)
                Next myBookmark
                For Each myField In .Fields
                        'myField.Unlink '删除所有烦人链接
                Next myField
        End With
        ActiveDocument.Save
        Call addReviseDate
End Sub
  • 按照《党政机关公文格式》GB/9704-2012的排版方式对一级、二级、三级、四级、五级标题进行排版,在使用前确定自己的电脑装有小标宋、黑体、仿宋。
  • 正文首行缩进2字符,如果段落第一个字是“致:”xx公司,或者“敬启者”则段落会顶格,不会缩进。
  • 更改所有硬回车为软回车
  • 去除所有空行
  • 去除半角空格
  • 去除全角空格
  • 替换非标准引号为标准引号
Sub 法律文件自动排版()
'
Application.ScreenUpdating = False
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^l"
.Replacement.Text = "^p"
.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.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.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.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = """(*)"""
.Replacement.Text = ChrW(8220) & "\1" & ChrW(8221)
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Dim qjsz, bjsz As String, iii As Integer
qjsz = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ,/<>?;’:[]{}\|=-+_)(*%$#@!`~&"
bjsz = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ,/《》?;':【】{}\|=-+_)(×%$#@!'〜&"
Selection.WholeStory
For iii = 1 To 95
With Selection.Find
.Text = Mid(qjsz, iii, 1)
.Replacement.Text = Mid(bjsz, iii, 1)
.Format = False
.MatchWildcards = False
.Execute Replace:=wdReplaceAll
End With
Next iii
With ActiveDocument.Styles(wdStyleHeading1).Font
.Color = wdColorBlack
.Bold = True
.Size = 22
.Name = "小标宋"
End With
With ActiveDocument.Styles(wdStyleHeading2).Font
.Color = wdColorBlack
.Bold = False
.Size = 14
.Name = "黑体"
End With
With ActiveDocument.Styles(wdStyleHeading3).Font
.Color = wdColorBlack
.Bold = True
.Size = 14
.Name = "楷体"
End With
With ActiveDocument.Styles(wdStyleHeading4).Font
.Color = wdColorBlack
.Bold = True
.Size = 14
.Name = "仿宋"
End With
With ActiveDocument.Styles(wdStyleHeading5).Font
.Color = wdColorBlack
.Bold = False
.Size = 14
.Name = "仿宋"
End With
With ActiveDocument.Styles(wdStyleNormal).Font
.Color = wdColorBlack
.Bold = False
.Size = 14
.Name = "仿宋"
End With
Dim ib As Paragraph
For Each ib In ActiveDocument.Paragraphs
If ib.Range.Information(wdWithInTable) = False Then
ib.Range.Select
Selection.ClearFormatting

If ib.Range.Characters.Last.Previous = "。" Or ib.Range.Characters.Last.Previous = ";" Then GoTo N2
Else
End If

If ib.Range Like "[一二三四五六七八九十百零千]、*" Then
If ib.Range.Sentences.Count = 1 Then
ib.Range.Style = wdStyleHeading2
Else
End If

ElseIf ib.Range Like "([一二三四五六七八九十百零千])*" Then
If ib.Range.Sentences.Count = 1 Then
ib.Range.Style = wdStyleHeading3
Else
End If

ElseIf ib.Range Like "[0-9][、..]*" Then
If ib.Range.Sentences.Count = 1 Then
ib.Range.Style = wdStyleHeading4
Else
End If
ElseIf ib.Range Like "([0-9])*" Then
If ib.Range.Sentences.Count = 1 Then
ib.Range.Style = wdStyleHeading5
Else
End If
Else
End If

N2:
Next
With ActiveDocument.Paragraphs(1)
.SpaceAfter = 12
.SpaceBefore = 12
End With
With ActiveDocument.Paragraphs(1).Range
.Style = ActiveDocument.Styles(wdStyleHeading1)
.ParagraphFormat.Alignment = wdAlignParagraphCenter
End With
paragraphcount = ActiveDocument.Paragraphs.Count
Set myrange = ActiveDocument.Range(Start:=ActiveDocument.Paragraphs(2).Range.Start, End:=ActiveDocument.Paragraphs(paragraphcount).Range.End)
myrange.Select
With Selection.ParagraphFormat
.LineSpacing = LinesToPoints(1.5)
.CharacterUnitFirstLineIndent = 2
.SpaceAfter = 0
.SpaceBefore = 0
End With
Selection.HomeKey Unit:=wdStory
With Selection.Find
.Text = "致:"
Do While .Execute(Forward:=True) = True
With Selection
.MoveEnd Unit:=wdParagraph, Count:=1
Selection.ParagraphFormat.Reset
Selection.Font.Bold = True
.Collapse Direction:=wdCollapseEnd
End With
Loop
End With
Selection.HomeKey Unit:=wdStory
With Selection.Find
.Text = "敬启者"
Do While .Execute(Forward:=True) = True
With Selection
.MoveEnd Unit:=wdParagraph, Count:=1
Selection.ParagraphFormat.Reset
Selection.Font.Bold = True
.Collapse Direction:=wdCollapseEnd
End With
Loop
End With
End Sub

4.最后困扰的解决
去除空格

去除空格(按章节替换,最简)
ActiveDocument.Sections(1).Range.Find.Execute findtext:=" ", replacewith:="", _
       Replace:=wdReplaceAll
去除空格(按段落循环)
For p = 1 To ActiveDocument.Paragraphs.Count
       ActiveDocument.Paragraphs(p).Range.Find.Execute findtext:=" ", replacewith:="", _
           Replace:=wdReplaceAll
   Next p
删除段落前后的空格
For a = 1 To ActiveDocument.Paragraphs.Count
       Set sutRng = ActiveDocument.Paragraphs(a).Range
       'MsgBox Len(strTmp)
 sutRng.MoveEnd wdCharacter, -1
       sutRng.Text = Trim(sutRng.Text)
 sutRng.MoveEnd wdCharacter, 1
       ActiveDocument.Paragraphs(a).Range.Text = sutRng.Text
   Next a
©著作权归作者所有,转载或内容合作请联系作者
  • 序言:七十年代末,一起剥皮案震惊了整个滨河市,随后出现的几起案子,更是在滨河造成了极大的恐慌,老刑警刘岩,带你破解...
    沈念sama阅读 159,716评论 4 364
  • 序言:滨河连续发生了三起死亡事件,死亡现场离奇诡异,居然都是意外死亡,警方通过查阅死者的电脑和手机,发现死者居然都...
    沈念sama阅读 67,558评论 1 294
  • 文/潘晓璐 我一进店门,熙熙楼的掌柜王于贵愁眉苦脸地迎上来,“玉大人,你说我怎么就摊上这事。” “怎么了?”我有些...
    开封第一讲书人阅读 109,431评论 0 244
  • 文/不坏的土叔 我叫张陵,是天一观的道长。 经常有香客问我,道长,这世上最难降的妖魔是什么? 我笑而不...
    开封第一讲书人阅读 44,127评论 0 209
  • 正文 为了忘掉前任,我火速办了婚礼,结果婚礼上,老公的妹妹穿的比我还像新娘。我一直安慰自己,他们只是感情好,可当我...
    茶点故事阅读 52,511评论 3 287
  • 文/花漫 我一把揭开白布。 她就那样静静地躺着,像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上,一...
    开封第一讲书人阅读 40,692评论 1 222
  • 那天,我揣着相机与录音,去河边找鬼。 笑死,一个胖子当着我的面吹牛,可吹牛的内容都是我干的。 我是一名探鬼主播,决...
    沈念sama阅读 31,915评论 2 313
  • 文/苍兰香墨 我猛地睁开眼,长吁一口气:“原来是场噩梦啊……” “哼!你这毒妇竟也来了?” 一声冷哼从身侧响起,我...
    开封第一讲书人阅读 30,664评论 0 202
  • 序言:老挝万荣一对情侣失踪,失踪者是张志新(化名)和其女友刘颖,没想到半个月后,有当地人在树林里发现了一具尸体,经...
    沈念sama阅读 34,412评论 1 246
  • 正文 独居荒郊野岭守林人离奇死亡,尸身上长有42处带血的脓包…… 初始之章·张勋 以下内容为张勋视角 年9月15日...
    茶点故事阅读 30,616评论 2 245
  • 正文 我和宋清朗相恋三年,在试婚纱的时候发现自己被绿了。 大学时的朋友给我发了我未婚夫和他白月光在一起吃饭的照片。...
    茶点故事阅读 32,105评论 1 260
  • 序言:一个原本活蹦乱跳的男人离奇死亡,死状恐怖,灵堂内的尸体忽然破棺而出,到底是诈尸还是另有隐情,我是刑警宁泽,带...
    沈念sama阅读 28,424评论 2 254
  • 正文 年R本政府宣布,位于F岛的核电站,受9级特大地震影响,放射性物质发生泄漏。R本人自食恶果不足惜,却给世界环境...
    茶点故事阅读 33,098评论 3 238
  • 文/蒙蒙 一、第九天 我趴在偏房一处隐蔽的房顶上张望。 院中可真热闹,春花似锦、人声如沸。这庄子的主人今日做“春日...
    开封第一讲书人阅读 26,096评论 0 8
  • 文/苍兰香墨 我抬头看了看天上的太阳。三九已至,却和暖如春,着一层夹袄步出监牢的瞬间,已是汗流浃背。 一阵脚步声响...
    开封第一讲书人阅读 26,869评论 0 197
  • 我被黑心中介骗来泰国打工, 没想到刚下飞机就差点儿被人妖公主榨干…… 1. 我叫王不留,地道东北人。 一个月前我还...
    沈念sama阅读 35,748评论 2 276
  • 正文 我出身青楼,却偏偏与公主长得像,于是被迫代替她去往敌国和亲。 传闻我的和亲对象是个残疾皇子,可洞房花烛夜当晚...
    茶点故事阅读 35,641评论 2 271

推荐阅读更多精彩内容

  • 声明:此文章属于转载文章作者:金小俊链接:https://www.jianshu.com/p/4a1531bac3...
    我的大好时光阅读 347评论 0 3
  • 宏,简单来说就是按预定义的规则来替换相应的文本内容,被替换的文本内容可以是对象也可以是函数。既然是替换,那就需要遵...
    金小俊阅读 4,564评论 6 54
  • 姓名:吕彬 学号:1613014035 【嵌牛导读】#define 宏定义是个演技非常高超的替身演员,但也会经常耍...
    傻彬儿阅读 1,193评论 0 1
  • 写在前面 在开发过程中很多时候需要阅读第三方源码,但是里面有大量的宏。没有换行,没有着色,与平时写的代码完全不同,...
    走进科学阅读 661评论 0 2
  • 关于宏 宏定义在C系开发中可以说占有举足轻重的作用。底层框架自不必说,为了编译优化和方便,以及跨平台能力,宏被大量...
    Cheriez阅读 728评论 0 4