Word VBA宏用于清除空段落并在前后添加空格

我有一个小宏，其目的是删除所有空段落^p，然后选择所有段落，并在每个段落的6个点前后添加空格

这是到目前为止的代码

Sub format()

ActiveDocument.Range.Select

' Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.text = "^p^p"
.Replacement.text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False
End With
Selection.Find.Execute Replace:=wdReplaceAll


iParCount = ActiveDocument.Paragraphs.Count
For J = 1 To iParCount
    ActiveDocument.Paragraphs(J).SpaceAfter = 6
    ActiveDocument.Paragraphs(J).SpaceBefore = 6
Next J
End Sub

然而，当我运行它时，所有内容都变成了一个段落。所以我喜欢^p是空段落

paragraph 1 
^p
paragraph 2 
^p
paragraph 3

我总是很紧张

paragraph 1 paragraph 2 paragraph 3

---

我做错了什么？谢谢

您需要通过循环执行此操作，并从文档末尾开始，以便从计数中删除删除的段落

Sub FormatParagraphs()

    Dim Para As Paragraph
    Dim i As Long

    Application.ScreenUpdating = False
    With ActiveDocument
        For i = .Paragraphs.Count To 1 Step -1
            Set Para = .Paragraphs(i)
            With Para
                If .Range.End - .Range.Start = 1 Then
                    .Range.Delete
                Else
                    .SpaceBefore = 6
                    .SpaceAfter = 6
                End If
            End With
        Next i
    End With
    Application.ScreenUpdating = True
End Sub

---

您前面的段落示例不正确。再看看你的段落。然后想想你正在用什么替换什么