MS Word 宏删除所有空段落留下部分中断

Question

我在 MS Word 中编写了这个宏来删除所有空段落。它运行良好，但如果文档包含多个部分，宏会删除中断并将所有部分合并为一个部分。

Dim i As Long
With ActiveDocument.Range
    For i = .Paragraphs.Count To 1 Step -1
        If Len(.Paragraphs(i).Range.Text) = 1 Then
            .Paragraphs(i).Range.Delete
        End If
    Next i
End With

我该如何解决这个问题？

Answer 1

使用替换

Sub ReplaceEmptyParagraphs()
    ' https://wordmvp.com/FAQs/MacrosVBA/DeleteEmptyParas.htm by Word MVP Dave Rado
    ' this procedure compiled from above by Charles Kenyon 6/29/2021
    '   IN GENERAL - EMPTY PARAGRAPHS
    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

    '   FIRST AND LAST EMPTY PARAGRAPHS
    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

    '   BEFORE AND AFTER TABLES
    Dim oTable As Table

    For Each oTable In ActiveDocument.Tables
        #If VBA6 Then
            'The following is only compiled and run if Word 2000 or 2002 is in use
            'It speeds up the table and your code
            oTable.AllowAutoFit = False
        #End If

        'Set a range to the para following the current table
        Set MyRange = oTable.range
        MyRange.Collapse wdCollapseEnd
        'if para after table empty, delete it
        If MyRange.Paragraphs(1).range.Text = vbCr Then
            MyRange.Paragraphs(1).range.Delete
        End If

        'Set a range to the para preceding the current table
        Set MyRange = oTable.range
        MyRange.Collapse wdCollapseStart
        MyRange.Move wdParagraph, -1
        'if para before table empty, delete it
        If MyRange.Paragraphs(1).range.Text = vbCr Then
            MyRange.Paragraphs(1).range.Delete
        End If
    Next oTable
    Set MyRange = Nothing
    Set oTable = Nothing
End Sub

参见 Word MVP Dave Rado 的 Remove all empty paragraphs from a document。查看完整文章。

You can remove most empty paragraphs from a document by doing a wildcard Find & Replace.

Answer 2

除非您的文档中有以空段落开头的表格，否则您甚至不需要 VBA！您只需要一个 通配符 Find/Replace，其中：

Find = [^13]{2,}
Replace = ^p

当然，这可以合并到宏中，代码如下：

With ActiveDocument.Range.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "[^13]{2,}"
    .Replacement.Text = "^p"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False 
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
End With

如果您确实有以空段落开头的表格，请参阅：

https://www.msofficeforums.com/167142-post9.html

MS Word 宏删除所有空段落留下部分中断

MS Word macro to delete all empty paragraphs leaving sections interruptions

vba

ms-word

使用替换