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

标签：Word VBA

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

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

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

代码语言：javascript复制

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

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

代码语言：javascript复制

Dim myRange As Range
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

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

代码语言：javascript复制

Dim objTable As Table
Dim myRange As Range
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 objTable

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

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

代码语言：javascript复制

Dim objTable As Table
Dim objCell As Cell
Dim myRange As Range
Dim lngCount As Long
For 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 lngCount
Next objTable

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

代码语言：javascript复制

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 objTable
End Sub

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

vba 腾讯云测试服务

0 人点赞