Word VBA宏可清理空段落並在之前和之后添加空間

Question

我有這個小宏，目的是刪除所有空的段落（^ 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

我究竟做錯了什么？ 謝謝！

Answer 1

您需要循環執行此操作，並從文檔末尾開始，以便從計數中刪除已刪除的段落。

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