怎样用Word VBA删除空行（3楼解决了）

roger600001

每篇文章都有几十行空行，打印太浪费纸

在网上查了这个VBA
Sub DelBlank()
'
' DelBlank 宏
'
'

    Dim i As Paragraph, n As Long
    Application.ScreenUpdating = False '关闭屏幕刷新
    For Each i In ActiveDocument.Paragraphs '在活动文档的段落集合中循环
        If Len(i.Range) = 1 Then '判断段落长段,此处可根据文档实际情况
            i.Range.Delete '进行必要的修改可将任意长度段落删除
            n = n + 1 '计数
        End If
    Next
    MsgBox "共删除空白段落" & n & "个!"
    Application.ScreenUpdating = True '恢复屏幕刷新


End Sub


对我的附件没用，我新建了一个文档可以执行，为什么？



用2楼的   搜索 ^P^P  替换为 ^P，对我的附件也不行。
3楼的部分行，谢谢大家了。

[ 本帖最后由 roger600001 于 2009-12-20 18:00 编辑 ]

coby001

搜索 ^P^P  替换为 ^P

kqbt

1. Sub DelBlaRows()
   
2.     ActiveDocument.Content.Find.Execute _
   
3.     findtext:="[^11^13]{1,}", MatchWildcards:=True, _
   
4.     replacewith:="^p", Replace:=wdReplaceAll
   
5. End Sub
   

复制代码

szqhb

当段落符前面有空格时不行，可否加进替换此类代码？

清风明月九

我试了，对一楼的附近有用啊！谢谢一楼的代码

413191246se

以下为VBA小菜鸟本人之最新自编独创代码，希望对大家有所帮助：

1. Sub 删除段落首尾空格及空行()
   
2.     ActiveDocument.Content.Find.Execute findtext:="^l", replacewith:="^p", Replace:=wdReplaceAll    '手动换行符 => 段落标记（全部替换）
   
3.     ActiveDocument.Content.Find.Execute findtext:="^13", replacewith:="^p", Replace:=wdReplaceAll   '真假回车符 => 段落标记
   
4.     ActiveDocument.Content.Find.Execute findtext:="^s", replacewith:=" ", Replace:=wdReplaceAll     '不间断空格 => 半角空格
   
5.     ActiveDocument.Content.Find.Execute findtext:="(", replacewith:="（", Replace:=wdReplaceAll     '英文左括号 => 中文左括号
   
6.     ActiveDocument.Content.Find.Execute findtext:=")", replacewith:="）", Replace:=wdReplaceAll     '英文右括号 => 中文右括号
   
7. 
   
8.     Dim i As Paragraph, n As Long
   
9.     For Each i In ActiveDocument.Paragraphs
   
10.         For n = 1 To i.Range.Characters.Count
    
11.             If i.Range Like " *" Or i.Range Like "　*" Or i.Range Like Chr(9) & "*" Then
    
12.                 i.Range.Characters(1).Delete
    
13.             ElseIf i.Range Like "* " & Chr(13) Or i.Range Like "*　" & Chr(13) Or i.Range Like "*" & Chr(9) & Chr(13) Then
    
14.                 Do
    
15.                     i.Range.Select
    
16.                     Selection.EndKey Unit:=wdLine
    
17.                     Selection.TypeBackspace
    
18.                 Loop Until Asc(i.Range.Characters(i.Range.Characters.Count - 1)) <> 32 Or Asc(i.Range.Characters(i.Range.Characters.Count - 1)) <> 9
    
19.             Else
    
20.                 Exit For
    
21.             End If
    
22.         Next n
    
23.         If Len(i.Range) = 1 Then i.Range.Delete
    
24.     Next
    
25. 
    
26. ' 特例
    
27.     For Each i In ActiveDocument.Paragraphs
    
28.         If i.Range Like " “*" Or i.Range Like " (*" Then
    
29.             i.Range.Select
    
30.             Selection.HomeKey Unit:=wdLine
    
31.             Selection.Delete Unit:=wdCharacter, Count:=1
    
32.         End If
    
33.         If i.Range Like "*) " & Chr(13) Or i.Range Like "*” " & Chr(13) Then
    
34.             i.Range.Select
    
35.             Selection.EndKey Unit:=wdLine
    
36.             Selection.TypeBackspace
    
37.         End If
    
38.     Next
    
39. End Sub

复制代码

szqhb

做个记号，费事用时找不着

413191246se

当今全世界最好最新的——删除段落首尾空格及空行（宏）：

Sub delSpaceLine()
    With ActiveDocument.Content.Find
        .Execute findtext:="^l", replacewith:="^p", Replace:=wdReplaceAll
        .Execute findtext:="^13", replacewith:="^p", Replace:=wdReplaceAll
        .Execute findtext:="(", replacewith:="（", Replace:=wdReplaceAll
        .Execute findtext:=")", replacewith:="）", Replace:=wdReplaceAll
    End With
    SendKeys "^(aej)", True
    Dim i As Paragraph
    For Each i In ActiveDocument.Paragraphs
        If Len(i.Range) = 1 Then i.Range.Delete
    Next
    ActiveDocument.Content.ListFormat.ConvertNumbersToText
    ActiveDocument.Content.Find.Execute findtext:="^t", replacewith:="", Replace:=wdReplaceAll
End Sub

roger600001

感谢413191246se ，强力收藏

molihim

做个记号收藏学习

今天用上这个了：ActiveDocument.Content.Find.Execute findtext:="^13", replacewith:="^p", Replace:=wdReplaceAll   '真假回车符 => 段落标记

太好了，谢谢楼主