Microsoft Office Forums - View Single Post - [Solved] Format multiple paragraphs differently

gmayor · 07-25-2019, 08:16 PM

For your code to work you need to select the four paragraphs first.

If the whole document is formatted like your example with several blocks of four separated by three empty paragraphs, you can format the lot at one go e.g.

Code:

Sub Format_Route()
'https://social.msdn.microsoft.com/Forums/en-US/d616f43f-a9c2-4e70-937b-c778ed229bb3/need-help-regarding-formatting-multiple-paragraphs-individually-in-word-using-vba?forum=isvvba

Dim i As Long
Dim oRng As Range
    For i = 1 To ActiveDocument.Paragraphs.Count Step 7
        Set oRng = ActiveDocument.Paragraphs(i).Range
        oRng.End = ActiveDocument.Paragraphs(i + 4).Range.End
        oRng.Select

        With Selection.Paragraphs(1)  'ROAD NAME
            .LeftIndent = CentimetersToPoints(0)
            .SpaceBefore = 0
            .SpaceBeforeAuto = False
            .SpaceAfter = 4
            .SpaceAfterAuto = False
            .LineSpacingRule = wdLineSpaceSingle
            .Alignment = wdAlignParagraphLeft
            .KeepWithNext = True
            With .Range.Font
                .Name = "Times New Roman"
                .Size = 12
                .Bold = True
            End With
        End With

        With Selection.Paragraphs(2)  'RESTRICTION
            .LeftIndent = CentimetersToPoints(0.2)
            .SpaceBefore = 0
            .SpaceBeforeAuto = False
            .SpaceAfter = 0
            .SpaceAfterAuto = False
            .LineSpacingRule = wdLineSpaceSingle
            .Alignment = wdAlignParagraphLeft
            .KeepWithNext = True
            With .Range.Font
                .Name = "Times New Roman"
                .Size = 12
                .Bold = True
            End With
        End With

        With Selection.Paragraphs(3)  'STRUCTURE TYPE AND STRUCTURE NUMBER
            .LeftIndent = CentimetersToPoints(1.27)
            .SpaceBefore = 0
            .SpaceBeforeAuto = False
            .SpaceAfter = 0
            .SpaceAfterAuto = False
            .LineSpacingRule = wdLineSpaceSingle
            .Alignment = wdAlignParagraphLeft
            .KeepWithNext = True
            With .Range.Font
                .Name = "Times New Roman"
                .Size = 12
                .Bold = False
            End With
        End With

        With Selection.Paragraphs(4)  'STRUCTURE LOCATION
            .LeftIndent = CentimetersToPoints(1.27)
            .SpaceBefore = 0
            .SpaceBeforeAuto = False
            .SpaceAfter = 0
            .SpaceAfterAuto = False
            .LineSpacingRule = wdLineSpaceSingle
            .Alignment = wdAlignParagraphLeft
            .KeepWithNext = False
            With .Range.Font
                .Name = "Times New Roman"
                .Size = 12
                .Bold = False
            End With
        End With
    Next i
End Sub

or simply program the ranges without selecting them e.g.

Code:

Sub Format_Route()
'https://social.msdn.microsoft.com/Forums/en-US/d616f43f-a9c2-4e70-937b-c778ed229bb3/need-help-regarding-formatting-multiple-paragraphs-individually-in-word-using-vba?forum=isvvba

Dim i As Long
Dim oRng As Range
    For i = 1 To ActiveDocument.Paragraphs.Count Step 7
        Set oRng = ActiveDocument.Paragraphs(i).Range
        oRng.End = ActiveDocument.Paragraphs(i + 4).Range.End
 
        With oRng.Paragraphs(1)  'ROAD NAME
            .LeftIndent = CentimetersToPoints(0)
            .SpaceBefore = 0
            .SpaceBeforeAuto = False
            .SpaceAfter = 4
            .SpaceAfterAuto = False
            .LineSpacingRule = wdLineSpaceSingle
            .Alignment = wdAlignParagraphLeft
            .KeepWithNext = True
            With .Range.Font
                .Name = "Times New Roman"
                .Size = 12
                .Bold = True
            End With
        End With

        With oRng.Paragraphs(2)  'RESTRICTION
            .LeftIndent = CentimetersToPoints(0.2)
            .SpaceBefore = 0
            .SpaceBeforeAuto = False
            .SpaceAfter = 0
            .SpaceAfterAuto = False
            .LineSpacingRule = wdLineSpaceSingle
            .Alignment = wdAlignParagraphLeft
            .KeepWithNext = True
            With .Range.Font
                .Name = "Times New Roman"
                .Size = 12
                .Bold = True
            End With
        End With

        With oRng.Paragraphs(3)  'STRUCTURE TYPE AND STRUCTURE NUMBER
            .LeftIndent = CentimetersToPoints(1.27)
            .SpaceBefore = 0
            .SpaceBeforeAuto = False
            .SpaceAfter = 0
            .SpaceAfterAuto = False
            .LineSpacingRule = wdLineSpaceSingle
            .Alignment = wdAlignParagraphLeft
            .KeepWithNext = True
            With .Range.Font
                .Name = "Times New Roman"
                .Size = 12
                .Bold = False
            End With
        End With

        With oRng.Paragraphs(4)  'STRUCTURE LOCATION
            .LeftIndent = CentimetersToPoints(1.27)
            .SpaceBefore = 0
            .SpaceBeforeAuto = False
            .SpaceAfter = 0
            .SpaceAfterAuto = False
            .LineSpacingRule = wdLineSpaceSingle
            .Alignment = wdAlignParagraphLeft
            .KeepWithNext = False
            With .Range.Font
                .Name = "Times New Roman"
                .Size = 12
                .Bold = False
            End With
        End With
    Next i
End Sub