Word一键排版

 Word一键排版宏

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
    '去除所有空行
    Dim i As Paragraph, n As Integer
    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
    '去除半角空格
    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
    '字母数字符号全角转半角 Macro
    Dim qjsz, bjsz As String, iii As Integer '定义qjsz(全角数字)、bjsz(半角数字)为字符串型，iii为整数型
        qjsz = "０１２３４５６７８９ａｂｃｄｅｆｇｈｉｊｋｌｍｎｏｐｑｒｓｔｕｖｗｘｙｚＡＢＣＤＥＦＧＨＩＪＫＬＭＮＯＰＱＲＳＴＵＶＷＸＹＺ,./<>?;’:[]{}\|=-+_)(*%$#@!`~&"
        bjsz = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ，。／《》？；'：【】｛｝＼｜＝－＋＿）（×％＄＃＠！'～＆"
        Selection.WholeStory
    For iii = 1 To 95 '循环10次
    With Selection.Find
       .Text = Mid(qjsz, iii, 1) 'mid函数：返回文本字符串中从指定位置开始的特定数目的字符，每次取一个数字
       .Replacement.Text = Mid(bjsz, iii, 1) '将用于替换的相应位置的半角数字
       .Format = False '保留替换前的字符格式
       .MatchWildcards = False
       .Execute Replace:=wdReplaceAll '用半角符号替换全角符号
    End With
    Next iii
    '修改小数点错误
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "([0-9])。([0-9])"
        .Replacement.Text = "\1.\2"
        .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
    '设置字号
    Selection.WholeStory  '全选
    Selection.ClearFormatting  '清除全文格式
    Selection.Font.Size = 14  '设置字号为14号
    '设置行距
    Selection.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
    Selection.ParagraphFormat.LineSpacing = 25
    Selection.ParagraphFormat.Alignment = wdAlignParagraphJustify  '设置文本为两端对齐
    Selection.ParagraphFormat.CharacterUnitFirstLineIndent = 2  '设置段首缩进2字符
    Selection.HomeKey Unit:=wdStory  '移至文首
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend  '选中首行
    Selection.ClearFormatting  '清除首行格式
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter  '设置首行居中对齐
    Selection.ParagraphFormat.LineUnitBefore = 1  '设置首行段前间距1行
    Selection.ParagraphFormat.LineUnitAfter = 1  '设置首行段后间距1行
    Selection.Font.Name = "微软雅黑"  '设置首行字体为“微软雅黑”
    Selection.Font.Size = 18  '设置首行字号为18号
    Selection.Font.Bold = wdToggle  '设置首行字形为加粗
    Application.ScreenUpdating = True
    MsgBox "文本整理完毕", , "真特么好用，哈哈哈。"

End Sub