計算機興趣——Word——宏——一鍵處理百度百科文字格式整理

    計算機是用來自動化人工作的。。。
    
    這篇文章是幹什麼的？當你複製網上的文字，再粘貼到word上時，往往需要修改格式。eg：字體大小，居中，換行，設置標題。這種重複枯燥的操作，就應當交由計算機一鍵化秒秒鐘處理，將人解放出來。所以，這有了這篇文章。
    
    你需要安裝Office Word 2007，如果是Word 2003，可能，會出一點點小問題，刪除出問題的那段代碼就行了。因爲有些東西Word 2007的東西，Word 2003不支持。如果是WPS的話，很抱歉，人家幾百M的軟件的功能還是強大很多的。（WPS免費版沒有 宏 的功能）。

    原理：就是利用Word 宏的功能。簡而言之，就是用程序代替你設置文字的大小，標題的操作。而執行這段程序只需秒秒鐘的時間。這段程序就叫做宏。所以，下面就是那段一鍵化的代碼。

    這篇文章的由來：雖然網上有各種格式化粘貼文字的宏，但不能針對特定網站。例如，我想把百度百科的全部內容全部複製粘貼到Word，用網上百度到的宏，只能把它全部整理成一種格式（eg：五號字體，但沒標題）。所以，下面的宏，是針對百度百科的，且已經稍作修改，可以格式化一般網站上的文字。你如果稍作修改，也能適應特定的網站，也可以適應一般的網站。如果你想需要將維基百科上的內容複製粘貼且打印的話，直接選擇Adobe Acrobat Printer，Printer將自動設置好了字體大小，標題，換行。（如果你裝了Adobe Acrobat 軟件，一般情況是有的Printer的，沒有就是Ghost系統沒有一些服務o(╯□╰)o）


已經有的功能：刪除段前距，段後距，行距（這樣打印就不浪費紙）。正文設置爲五號，這樣打印出來的字，既不會太大，也不會太小。按Word已經有的標題格式，重新設置標題，也可以略修改，按自己的需求設置。將所有的字體顏色設置爲黑色。正文字體大小和標題均可以按自己的需求設置。
沒有的功能/Bug/希望能增加的功能：標題設置後的效果和手動點標題設置的效果不一樣。將百度百科的內容複製粘貼過來，標題2，標題3就已經是Word內建的標題了，所以標題2，標題3不好設置，需手工設置。因爲我的打印文檔已經默認設置好頁邊距，和頁腳，所以下面的代碼沒有頁邊距和頁腳的設置。我希望增加自動插入頁眉的功能。

下面是宏代碼：

Sub 百度百科一鍵整理()
'
' 百度百科一鍵整理 宏
'2013年12月19日，星期四。
'
'
'
    '---------替換空格------
    Selection.WholeStory
    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
' 替換全角空格
    Selection.WholeStory
    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
'---------替換換行------
    Selection.WholeStory
    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
    
    
    '刪除“編輯”兩個字。可能會多刪除，但一般是不會的。
    Selection.WholeStory
    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
    
    
    
    
    
    '增加新段落的縮進
    Selection.WholeStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^p"
        .Replacement.Text = "^p^t"
        .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
    
    
    
    '修改標題1， （因爲標題2， 3系統已經默認修改好了）
    Selection.WholeStory
    Selection.Find.ClearFormatting
    Selection.Find.Font.Size = 17 '有時候好像是13.5，所以下面還有一個類似的，只不過是13.5
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Style = ActiveDocument.Styles("標題 1")
    With Selection.Find.Replacement.Font
        .Size = 12
    End With
    With Selection.Find.Replacement.ParagraphFormat
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
        .Alignment = wdAlignParagraphCenter
        .WordWrap = True
    End With
    Selection.Find.Replacement.ParagraphFormat.TabStops.ClearAll
    With Selection.Find.Replacement.ParagraphFormat
        With .Shading
            .Texture = wdTextureNone
            .ForegroundPatternColor = wdColorBlack
            .BackgroundPatternColor = wdColorBlack
        End With
        .Borders.Shadow = False
    End With
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.EscapeKey
'修改標題1， （因爲標題2， 3系統已經默認修改好了）
    Selection.WholeStory
    Selection.Find.ClearFormatting
    Selection.Find.Font.Size = 13.5 '有時候好像是13.5，所以下面還有一個類似的，只不過是13.5
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Style = ActiveDocument.Styles("標題 1")
    With Selection.Find.Replacement.Font
        .Size = 12
    End With
    With Selection.Find.Replacement.ParagraphFormat
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
        .Alignment = wdAlignParagraphCenter
        .WordWrap = True
    End With
    Selection.Find.Replacement.ParagraphFormat.TabStops.ClearAll
    With Selection.Find.Replacement.ParagraphFormat
        With .Shading
            .Texture = wdTextureNone
            .ForegroundPatternColor = wdColorBlack
            .BackgroundPatternColor = wdColorBlack
        End With
        .Borders.Shadow = False
    End With
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.EscapeKey
    
    '修改正文，將    '將 七號 改爲 五號
    Selection.WholeStory
    Selection.Find.ClearFormatting
    Selection.Find.Font.Size = 7
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Size = 10.5
    End With
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    
    '刪除“編輯”之後，還有一個空行。，僅替換一次。
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^p^t"
        .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
    With Selection
        If .Find.Forward = True Then
            .Collapse Direction:=wdCollapseStart
        Else
            .Collapse Direction:=wdCollapseEnd
        End If
        .Find.Execute Replace:=wdReplaceOne
        If .Find.Forward = True Then
            .Collapse Direction:=wdCollapseEnd
        Else
            .Collapse Direction:=wdCollapseStart
        End If
        .Find.Execute
    End With
    
    
        ' 刪除行距、段距 宏
'-------刪除段前距--------
 Selection.WholeStory
    With Selection.ParagraphFormat
        .LeftIndent = CentimetersToPoints(0)
        .RightIndent = CentimetersToPoints(0)
        .SpaceBefore = 0
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
        .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
        .MirrorIndents = False
        .TextboxTightWrap = wdTightNone
        .AutoAdjustRightIndent = True
        .DisableLineHeightGrid = False
        .FarEastLineBreakControl = True
        .WordWrap = True
        .HangingPunctuation = True
        .HalfWidthPunctuationOnTopOfLine = False
        .AddSpaceBetweenFarEastAndAlpha = True
        .AddSpaceBetweenFarEastAndDigit = True
        .BaseLineAlignment = wdBaselineAlignAuto
    End With
    
    '------刪除段後距---------
    Selection.WholeStory
    With Selection.ParagraphFormat
        .LeftIndent = CentimetersToPoints(0)
        .RightIndent = CentimetersToPoints(0)
        .SpaceBefore = 0
        .SpaceBeforeAuto = False
        .SpaceAfter = 0
        .SpaceAfterAuto = False
        .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
    
    '--------刪除行距-------
    Selection.WholeStory
    With Selection.ParagraphFormat
        .LeftIndent = CentimetersToPoints(0)
        .RightIndent = CentimetersToPoints(0)
        .SpaceBefore = 0
        .SpaceBeforeAuto = False
        .SpaceAfter = 0
        .SpaceAfterAuto = False
        .LineSpacingRule = wdLineSpaceAtLeast
        .LineSpacing = 12
        .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
    
    
    
    
    
    '字體顏色處理
    Selection.WholeStory
    Selection.Font.Color = wdColorBlack
    
    
    
End Sub

     關於如何使用Word宏，百度，或者“http://wenku.baidu.com/link?url=zP5Ckji5u6mrfLIgU09Ia3DISQA_Dhn7vt033k8b3ISxpTU9yoTNeSeIAa2g404ZlK1k52p9SlXSsCeMqTQY1Km5UlTbW9b0Y7KwK-TG0je”，雖然講的不是很好。

歡迎大家提出新的需求，舉出bug，解決方案，Idea！
Ps：這代碼不是手寫的，是用“宏錄製”功能錄製的。我雖然是計算機專業的，但沒有Word相關課程，且一般計算機專業的也沒有Word相關課程。(⊙o⊙)…

歡迎轉載（轉載請說明出處）！