计算机兴趣——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⊙)…

欢迎转载(转载请说明出处)!



展开阅读全文

没有更多推荐了,返回首页