Format multiple paragraphs differently

gmayor · #5 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

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Changing the format/style for numbered paragraphs AND MAKING THEM STICK!	FearlessStamper	Word	2	10-30-2017 02:17 PM
Copying paragraphs from multiple documents to the current one.	paik1002	Word VBA	3	02-22-2016 04:03 AM
VBA to set format for paragraphs that meet with specific requirements	AustinBrister	Word VBA	3	06-01-2015 07:00 AM
Word 2003 form fields and pasting multiple paragraphs.	mwmoron	Word	1	12-07-2012 11:06 PM
Find and Replace multiple lines/paragraphs	jcw	Word	1	11-18-2011 11:47 AM