Microsoft Office Forums - View Single Post

gmayor · 01-20-2020, 12:12 AM

I assume that you mean you want a '+' sign in the space? That being the case you can adapt the previous macro e.g. as follows.

Code:

Sub Macro2()
'Graham Mayor - https://www.gmayor.com - Last updated - 20 Jan 2020 

 Dim i As Long
Dim oPara As Paragraph
Dim oRng As Range

    'Create styles or use existing styles
    On Error Resume Next
    ActiveDocument.Styles.Add Name:="Body_Spaced", Type:=wdStyleTypeParagraph
    ActiveDocument.Styles("Body_Spaced").AutomaticallyUpdate = False
    With ActiveDocument.Styles("Body_Spaced").Font
        .Name = "Calibri"
        .Size = 12
    End With
    With ActiveDocument.Styles("Body_Spaced").ParagraphFormat
        .SpaceAfter = 12
    End With
    ActiveDocument.Styles.Add Name:="Body_Unspaced", Type:= _
                              wdStyleTypeParagraph
    ActiveDocument.Styles("Body_Unspaced").AutomaticallyUpdate = False
    With ActiveDocument.Styles("Body_Unspaced").Font
        .Name = "Calibri"
        .Size = 12
    End With
    With ActiveDocument.Styles("Body_Unspaced").ParagraphFormat
        .SpaceAfter = 0
    End With
    On Error GoTo 0
    'end of style creation
    'apply styles
    For i = 1 To ActiveDocument.Paragraphs.Count
        Set oPara = ActiveDocument.Paragraphs(i)
        If i Mod 3 = 0 Then
            oPara.Range.Style = "Body_Spaced"
        Else
            oPara.Range.Style = "Body_Unspaced"
        End If
    Next i
    Set oRng = ActiveDocument.Range
    With oRng.Find
        .Style = "Body_Spaced"
        Do While .Execute
            If Len(oRng.Next.Paragraphs(1).Range) > 1 Then
                oRng.InsertAfter "+" & vbCr
            End If
            oRng.Style = "Body_Unspaced"
            oRng.Collapse 0
        Loop
    End With
    Set oRng = Nothing
    Set oPara = Nothing
End Sub

The main issue with inserting paragraphs at regular intervals is that of keeping track of the number of paragraphs. However you could do it another way without the need for changing the styles

Code:

Sub Macro3()
'Graham Mayor - https://www.gmayor.com - Last updated - 20 Jan 2020 

 Dim oRng As Range
Dim lngPara As Long
Dim lngCount As Long
Const lngNum As Long = 3    'the number of paragraphs to group
    lngCount = ActiveDocument.Paragraphs.Count
    For lngPara = lngCount To 1 Step -1
        'eliminate empty paragraphs at the end from the count
        If Len(ActiveDocument.Paragraphs(lngPara).Range) = 1 Then
            lngCount = lngCount - 1
        Else
            Exit For
        End If
    Next lngPara
    'Find the end of the last of the grouped paragraphs
    Do Until lngCount Mod lngNum = 0
        lngCount = lngCount - 1
    Loop
    'Insert paragraphs containing a '+' character
    For lngPara = lngCount To lngNum Step -lngNum
        Set oRng = ActiveDocument.Paragraphs(lngPara).Range
        oRng.InsertAfter "+" & vbCr
    Next lngPara
    Set oRng = Nothing
 End Sub

By omitting "+" & from the line

Code:

oRng.InsertAfter "+" & vbCr

this method could be used to insert empty paragraphs, though the styles are a better choice for that.