Word-VBA-Makro, um leere Absätze zu leeren und Leerzeichen nach und vor hinzuzufügen

Question

Ich habe dieses kleine Makro, dessen Zweck es ist, alle leeren Absätze (^ p) zu entfernen und dann alle Absätze auszuwählen und nach und vor Leerzeichen hinzuzufügen (je 6 Punkte) .

Dies ist der Code so weit

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 

Jedoch, wenn ich es laufen, alles, was ein einzelner Absatz wird. Nehme an Ich habe wie (^ p sind leere Absätze)

paragraph 1 
^p 
paragraph 2 
^p 
paragraph 3 

Ich bekomme immer

paragraph 1 paragraph 2 paragraph 3 

Was mache ich falsch? Vielen Dank!

Answer 1

Sie müssen dies mit einer Schleife tun und am Ende des Dokuments beginnen, damit gelöschte Absätze aus der Zählung eliminiert werden.

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