强大的word宏

网上拷贝的资料，粘贴到word以后，可能会有很多多余的回车，利用宏可以轻松删除。

打开菜单：工具→宏→录制新宏，打开“录制宏”对话框，输入宏的名字，单击确定开始录制宏。

2、按CTRL+H打开替换对话框，查找内容“^p^p”替换为“^p”，即将两个连续的回车符替换成一个回车符。可多单击几次“全部替换”按钮，因为可能有多个连续的回车符。 

3、单击停止录制按钮，完成录制。

看一下刚才录制的宏。打开菜单：工具→宏→Visual Basic 编辑器。

上面就是我们刚才录制的宏代码。

打开菜单：工具→宏→宏，打开“宏”对话框。

选中刚才录制的宏，单击运行，即可以将当前Word文档中的多余的回车符删除。

如果要经常使用，可以设置工具按钮或快捷键。设置方法如下：

在Word工具栏上右击→自定义…，打开“自定义”对话框。

找到刚才录制的宏，将其拖到工具栏合适的地方。

在刚添加的按钮上右击，可对按的名字、图像进行编辑。

单击“自定义”对话框上的“键盘…”按钮，打开“自定义键盘”对话框。

选中刚才录制的宏，按下合适的快捷键，关闭对话框，完成设置。

以后只要单击工具栏按钮或自定义的快捷键，就可以运行删除多余回车符了。

我的工具栏……　*_*

㈡删除空的段落

录制的宏，有很多代码实际上没用，可以对录制的宏代码进行手工编辑，下面宏代码即实现删除空的段落。

方案一，效率较高，但可能删除不了超过10亿个连续的回车符。Do While…… Loop，也可用　For ……Next语句替换。If I > 30 Then ……End If是为了循环次数。因为如果是第一段、最后一段是空段落，用替换功能删除不了。原因，知道的指教一下。

Sub 删多余回车()

    Dim I As Integer

    Selection.End = 0       '将光标移动到文档的开始

    Selection.Find.Execute "^l", , , , , , True, wdfindcontiue, False, "^p", wdReplaceAll    '将换行符替换成回车符

     I = 0

    Do While (Selection.Find.Execute("^p^p", , , , , , True, wdfindcontiue, False, "^p", wdReplaceAll))

        I = I + 1

If I > 30 Then

            If 1 = Len(ActiveDocument.Paragraphs(1).Range.Text) Then ActiveDocument.Paragraphs(1).Range.Delete　　　　　'如果第一段是空段落，则删除

            If 1 = Len(ActiveDocument.Paragraphs(ActiveDocument.Paragraphs.Count).Range.Text) Then ActiveDocument.Paragraphs(ActiveDocument.Paragraphs.Count).Range.Delete　　　　'如果最后一段是空段落，则删除

            Exit Do

        End If

    Loop

    MsgBox CStr(I)

End Sub

方案二，从当前文档的最后一段开始，逐段检查，如果只有一个字符，将该段删除。该方案效率相对较低，当文档上千段的时候，速度会让人崩溃。友情提醒，宏在运行时候，CTRL＋BREAK 键可以停止。

Sub 删多余回车()

    Dim I As Integer, 段落数 As Integer

    Selection.End = 0       '将光标移动到文档的开始

    Selection.Find.Execute "^l", , , , , , True, wdfindcontiue, False, "^p", wdReplaceAll  '将换行符替换成回车符

    段落数 = ActiveDocument.Paragraphs.Count

    For I = 段落数 To 1 Step -1  '删除多余回车

        If Len(ActiveDocument.Paragraphs(I).Range.Text) = 1 Then

            ActiveDocument.Paragraphs(I).Range.Delete

        End If

    Next I

End Sub

强大的word宏：㈢删除多余空格

Sub 删空格()

    替换 " ", "　" '半角空格替换成全角空格

    Do While (Selection.Find.Execute("^$　", , , , , , True, , False))       '英文字母全角空格后加半角空格

        Selection.Range.InsertAfter " "

    Loop

    替换 "　", ""      '删除中文空格

End Sub

Function 替换(被替换文本 As String, 替换文本 As String) As Boolean

    Selection.End = 0

    替换 = Selection.Find.Execute(被替换文本, , , , , , True, wdfindcontiue, False, 替换文本, wdReplaceAll)

End Function

强大的word宏：㈣调整字符间距

Sub 加大字间距()　　　'运行一次将选中文本字符间距加大0.1磅

    字符间距　 0.1

End Sub

Sub 减小字间距()　　　'运行一次将选中文本字符间距减小0.1磅

    字符间距  -0.1

End Sub

Function 字符间距(间距 As Single) 

    Selection.Font.Spacing = Selection.Font.Spacing + 间距

    If Selection.Font.Spacing = 0 Then MsgBox "字间距为标准值！"

End Function

宏演示视频：

http://user.qzone.qq.com/15032075/infocenter#!app=847&via=QZ.HashRefresh