Word VBA实战技巧：删除文档中所有的空段落

excelperfect

标签：Word VBA

有时候，Word文档中有很多空段落，我们想要快速删除这些空段落，该如何操作呢？

一种方法是使用Word的查找和替换功能，使用通配符查找：^13{2,}，使用^p替换。另一种方法是使用VBA。

与查找和替换功能等效的VBA代码如下：

With Selection.Find .Text = '^13{2,}' .Replacement.Text = '^p' .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True .Execute Replace:=wdReplaceAllEnd With

然而，这样不能删除文档中最开始和最末尾的空段落，需要添加使用下面的代码：

Dim myRange As RangeSet myRange = ActiveDocument.Paragraphs(1).RangeIf myRange.Text = vbCr Then myRange.DeleteSet myRange = ActiveDocument.Paragraphs.Last.RangeIf myRange.Text = vbCr Then myRange.Delete

此外，查找和替换也不能删除表格前后的空段落，需要添加使用下面的代码：

Dim objTable As TableDim myRange As RangeFor Each objTable In ActiveDocument.Tables #If VBA6 Then objTable.AllowAutoFit = False  #End If
'将范围设置为当前表格后面的段落 Set myRange = objTable.Range myRange.Collapse wdCollapseEnd '如果表格后面的段落为空则删除  If myRange.Paragraphs(1).Range.Text = vbCr Then myRange.Paragraphs(1).Range.Delete End If
'将范围设置为当前表格前面的段落  Set myRange = objTable.Range myRange.Collapse wdCollapseStart myRange.Move wdParagraph, -1 '如果表格前面的段落为空则删除  If myRange.Paragraphs(1).Range.Text = vbCr Then myRange.Paragraphs(1).Range.Delete End IfNext objTable

注意，如果两个表格之间使用的是空段落分隔，那么上面的代码会将两个表格合并为一个表格，这可能不是我们想要的结果。

同样，查找和替换也不能删除表格中单元格内的第一段或最后一段是空的段落，必须使用下面的代码来删除这些空段落：

Dim objTable As TableDim objCell As CellDim myRange As RangeDim lngCount As LongFor Each objTable In ActiveDocument.Tables  '使用objCell.Next遍历表格单元格比使用For Each objCell更快  Set objCell = objTable.Range.Cells(1)  For lngCount = 1 To objTable.Range.Cells.Count    If Len(objCell.Range.Text) > 2 And objCell.Range.Characters(1).Text = vbCr Then      '如果单元格不为空但以空段落开始则删除空段落      '注意空单元格包含2个字符;一个是段落标记，一个是单元格末尾标记       objCell.Range.Characters(1).Delete    End If
    If Len(objCell.Range.Text) > 2 And Asc(Right$(objCell.Range.Text, 3)) = 13 Then      '如果单元格不为空但以空段落结束则删除空段落      Set myRange = objCell.Range      myRange.MoveEnd Unit:=wdCharacter,Count:=-1      myRange.Characters.Last.Delete    End If
    Set objCell = objCell.Next Next lngCountNext objTable

这样，完整的删除文档中空段落的代码如下：

Sub DeleteEmptyParagraphs() Dim myRange As Range Dim objTable As Table Dim objCell As Cell
With Selection.Find .Text = '^13{2,}' .Replacement.Text = '^p' .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True .Execute Replace:=wdReplaceAll End With
 Set myRange = ActiveDocument.Paragraphs(1).Range If myRange.Text = vbCr Then myRange.Delete
 Set myRange = ActiveDocument.Paragraphs.Last.Range If myRange.Text = vbCr Then myRange.Delete
For Each objTable In ActiveDocument.Tables #If VBA6 Then objTable.AllowAutoFit = False #End If
Set myRange = objTable.Range myRange.Collapse wdCollapseEnd   If myRange.Paragraphs(1).Range.Text = vbCr Then myRange.Paragraphs(1).Range.Delete End If
Set myRange = objTable.Range myRange.Collapse wdCollapseStart myRange.Move wdParagraph, -1   If myRange.Paragraphs(1).Range.Text = vbCr Then myRange.Paragraphs(1).Range.Delete End If Next objTableEnd Sub

有兴趣的朋友，可以测试测试。