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