Create a macro to fix pagination inconsistencies in Word doc

[Sam1085]

Hi,

I'm trying to create a Word macro for add consistent paragraph spacing in my Word documents (Document page count = 10-20).

I tried this:

Code: Select all

Private Sub AfterSpaceSideHeads()
Dim oPar As Paragraph
Dim oRng As Word.Range
For Each oPar In ActiveDocument.Paragraphs
Set oRng = oPar.Range
    With oRng
       With .Find
            .ClearFormatting
            .Text = "[!.:]^013?{2}" 'Select side heading and first paragraph.
            .MatchWildcards = True
            .Execute
       End With
       Set oRng = oPar.Range
       If oPar.Range.Information(wdWithInTable) = False Then
       If oPar.Range.Paragraphs.Alignment = wdAlignParagraphLeft Then
       If oPar.Range.ParagraphFormat.PageBreakBefore = False Then
       If (oPar.Range.Paragraphs.SpaceBefore = 18) Then
    .Select ' I need to select paragraph to apply this format
        .ParagraphFormat.SpaceBefore = 6
        .ParagraphFormat.SpaceBeforeAuto = False
        .ParagraphFormat.SpaceAfter = 0
        .ParagraphFormat.SpaceAfterAuto = False
        Set oRng = Nothing
       End If
       End If
       End If
       End If
    End With
Next
End Sub

I tried this "[!.:]^013?{2}" to identify side heading and it's related first paragraph (All headings are not ending with colon or period in my doc).
But I'm troubling to add before space formatting to the paragraph. I attached a sample document with detailed comments.

Appreciate if someone can help. Thank you!

[Sam1085]

I edited above code ".ParagraphFormat.SpaceBefore = 6.Value" to ".ParagraphFormat.SpaceBefore = 6"

[HansV]

You don't need to loop through all paragraphs; looping through the Find results is much more efficient:

Code: Select all

Private Sub AfterSpaceSideHeads()
    Dim oPar As Paragraph
    Dim oRng As Word.Range
    Application.ScreenUpdating = False
    Selection.HomeKey Unit:=wdStory
    With Selection.Find
        .ClearFormatting
        .Text = "[!.:]^013?{2}" 'Select side heading and first paragraph.
        .MatchWildcards = True
        Do While .Execute
            Set oPar = Selection.Paragraphs(1)
            If Not oPar.Range.Information(wdWithInTable) Then
                If oPar.Alignment = wdAlignParagraphLeft Then
                    If Not oPar.PageBreakBefore Then
                        If oPar.SpaceBefore = 18 Then
                            oPar.SpaceBefore = 6
                            oPar.SpaceAfter = 0
                            oPar.Next.SpaceBefore = 6
                        End If
                    End If
                End If
            End If
        Loop
    End With
    Application.ScreenUpdating = True
End Sub

[Sam1085]

Thank you Hans. This it worked for my documents.

I have changed this line "oPar.SpaceBefore = 6" to "18" per my requirement. As you said, yes it's more efficient than first code.
Thanks again!

[HansV]

You can omit the line

Code: Select all

                            oPar.SpaceBefore = 18

since you check in the line above that SpaceBefore is already equal to 18.

[Sam1085]

Yes, you are correct.
Thank you Hans.

[Sam1085]

Hi Hans,

I need your help again for this...

I have to set 10pt paragraph character to all tables at the beginning and end of the table (but not in table; before and after the table).
Some times the spacing maintain as before/after spaces between table and paragraph. However I have to apply 10pt paragraph characters at the beginning and end of the table.

I have attached a sample Word file with details.

Test Document.docx

Not sure it's possible and I have no idea about how to select this exact range using a macro.
Thank you!

[HansV]

I'm not sure I understand, but try this (test on a copy of the document!):

Code: Select all

Sub BeforeAfterTables()
    Dim tbl As Table
    Dim rng As Range
    Application.ScreenUpdating = False
    For Each tbl In ActiveDocument.Tables
        Set rng = tbl.Range
        rng.Move Unit:=wdParagraph, Count:=-2
        rng.Expand Unit:=wdParagraph
        With rng
            .Font.Size = 10
            With .ParagraphFormat
                .SpaceBefore = 0
                .SpaceAfter = 0
            End With
        End With
        Set rng = tbl.Range
        rng.Move Unit:=wdParagraph, Count:=1
        rng.Expand Unit:=wdParagraph
        With rng
            .Font.Size = 10
            With .ParagraphFormat
                .SpaceBefore = 0
                .SpaceAfter = 0
            End With
        End With
    Next tbl
    Application.ScreenUpdating = True
End Sub

[Sam1085]

Thank you Hans for quick response.

I have added few lines to customize your code per my documents.

Code: Select all

Sub BeforeAfterTables()
    Dim tbl As Table
    Dim rng As Range
    Application.ScreenUpdating = False
    For Each tbl In ActiveDocument.Tables
        Set rng = tbl.Range 'Set 10pt para before table
        rng.Move Unit:=wdParagraph, Count:=-2
        rng.Expand Unit:=wdParagraph
        With rng
            .Font.Size = 10
            With .ParagraphFormat
                .SpaceBefore = 0
                .SpaceAfter = 0
            End With
        End With
        Set rng = tbl.Range ' Set 10pt para after table
        rng.Move Unit:=wdParagraph, Count:=1
        rng.Expand Unit:=wdParagraph
        With rng
            .Font.Size = 10
            With .ParagraphFormat
                .SpaceBefore = 0
                .SpaceAfter = 0
            End With
        End With
    Set rng = tbl.Range ' Set 0 After space between Para and Table
        rng.Move Unit:=wdParagraph, Count:=-3
        rng.Expand Unit:=wdParagraph
        Selection.EndKey Unit:=wdLine, Extend:=wdExtend
        With rng
            With .ParagraphFormat
                .SpaceAfter = 0
            End With
        End With
        Set rng = tbl.Range ' Set 0 Before space between Table and Para
        rng.Move Unit:=wdParagraph, Count:=2
        rng.Expand Unit:=wdParagraph
        Selection.EndKey Unit:=wdLine, Extend:=wdExtend
        With rng
            With .ParagraphFormat
                .SpaceBefore = 0
            End With
        End With
    Next tbl
    Application.ScreenUpdating = True
End Sub

Now I only need to add this:

img.png

Simply I need to understand how to determine if no empty paragraph character before and between the table and how to add it.

Test Document_New.docx

Thank you for help!!!

[HansV]

Perhaps this?

Code: Select all

Sub BeforeAfterTables()
    Dim tbl As Table
    Dim rng As Range
    Application.ScreenUpdating = False
    For Each tbl In ActiveDocument.Tables
        Set rng = tbl.Range 'Set 10pt para before table
        rng.Move Unit:=wdParagraph, Count:=-2
        rng.Expand Unit:=wdParagraph
        If Len(rng) > 2 Then
            rng.Select
            Selection.EndKey Unit:=wdLine
            Selection.TypeParagraph
            Set rng = Selection.Paragraphs(1).Range
        End If
        With rng
            .Font.Size = 10
            With .ParagraphFormat
                .SpaceBefore = 0
                .SpaceAfter = 0
            End With
        End With
        Set rng = tbl.Range ' Set 10pt para after table
        rng.Move Unit:=wdParagraph, Count:=1
        rng.Expand Unit:=wdParagraph
        If Len(rng) > 2 Then
            rng.Select
            Selection.HomeKey Unit:=wdLine
            Selection.TypeParagraph
            Set rng = Selection.Paragraphs(1).Previous.Range
        End If
        With rng
            .Font.Size = 10
            With .ParagraphFormat
                .SpaceBefore = 0
                .SpaceAfter = 0
            End With
        End With
        Set rng = tbl.Range ' Set 0 After space between Para and Table
        rng.Move Unit:=wdParagraph, Count:=-3
        rng.Expand Unit:=wdParagraph
        With rng
            With .ParagraphFormat
                .SpaceAfter = 0
            End With
        End With
        Set rng = tbl.Range ' Set 0 Before space between Table and Para
        rng.Move Unit:=wdParagraph, Count:=2
        rng.Expand Unit:=wdParagraph
        With rng
            With .ParagraphFormat
                .SpaceBefore = 0
            End With
        End With
    Next tbl
    Application.ScreenUpdating = True
End Sub

[Sam1085]

Thank you Hans,

That's the exactly what I needed to do. Your code is working perfectly.

In addition to that I'm using this code to set empty paragraphs (some places contains non breaking spaces with paragraphs character).

Code: Select all

Sub SetEmptyParagraphs()
With Selection.Find
    .ClearFormatting
    .Text = "^s{1,}^13"
    .Replacement.Text = "^p"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
End With
End Sub

However this code will work as follows:

img2.png

Is there another way to delete unwanted non breaking characters from empty lines?

Thank you again!

[HansV]

You could use

Code: Select all

    .Text = "^w^p"
    .Replacement.Text = "^p"
    .Matchwildcards = False

^w is the code for all white space (space, non-breaking space, em-space, en-space, and tab).

[Charles Kenyon]

You should be using styles to handle your formatting.

[Sam1085]

Thank you Hans. This method working...

[ChrisGreaves]

You should be using styles to handle your formatting.

I agree. That said, there is an argument for doing it by hand, if only for the exercise in programming.

I was going to suggest use of styles.

I did a lot of document conversion/cleansing work 20 years ago. I promoted styles strongly, but most of the incoming documents were so rotten and dirty that I felt that a brute-force macro was the only real solution.
The work split into three phases
(1) Brute Force clean up
(2) Automated application of styles.
(3) Submit Invoice

Cheers
Chris

[Charles Kenyon]

Chris,

Good thoughts.

My usual practice, when I have to clean up a "dirty" document to use as a template, is to paste as plain text and apply formatting using styles.

[ChrisGreaves]

My usual practice, when I have to clean up a "dirty" document to use as a template, is to paste as plain text and apply formatting using styles.

Ah! The good old Ctrl-A, Ctrl-C, Ctrl-Esc, down-arrow, Enter, Ctrl-V, Ctrl-A, Ctrl-C, Alt-TRab, Ctrl-V trick!
Cheers
Chris