Macro VBA Word pour nettoyer les paragraphes vides et ajouter de l'espace après et avant

Question

J'ai cette petite macro dont le but est de supprimer tous les paragraphes vides (^ p) puis de sélectionner tous les paragraphes et d'ajouter de l'espace après et avant (6 points chacun) .

Ce code est jusqu'à présent

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 

Cependant quand je le lance, tout devient un seul paragraphe. Supose J'ai comme (^ p sont des paragraphes vides)

paragraph 1 
^p 
paragraph 2 
^p 
paragraph 3 

Je reçois toujours

paragraph 1 paragraph 2 paragraph 3 

Qu'est-ce que je fais mal? Merci!

Answer 1

Vous devez le faire avec une boucle et commencer à la fin du document afin que les paragraphes supprimés soient éliminés du comptage.

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