Technorati 标签: Word宏 格式修正

Sub formatInternetWord()

    'Author:李文超

    '网上的文章复制粘贴为我所用，你会发现很多文稿多出了很多空格、空行，

    '有的是用手动换行符代替了段落标记，致使段首不能空两格显示。

    '这些问题既影响美观又占用纸张空间（打印时），

    '如果逐个删除那劳动量实在是太大了，

    '本人在实际操作中一开始用的也是笨功夫，

    '后来悟到完全可以录制宏来替换整理，省却诸多麻烦。

    '将^l替换为为^P.软回车替换为硬回车

    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 = wdOrientLandscape '页面方向为横向

        .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 '段前间距

        .SpaceAfter = 0 '段后间距

        .LineSpacingRule = wdLineSpace1pt '单倍行距,可以自定义数值

        .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

End Sub