Loop to add blank lines that repeats until end of the Word document

1
votes

I'm trying to write a macro to break up a long list of addresses for someone. Basically, the macro needs to add a blank line after every three lines AND repeat this procedure for the entire document. I have gotten the initial action to work, but I can't figure out how to get it to repeat and stop at the end of the document. I've searched online and keep finding while loops that only apply to situations in Excel. I'm not sure how to specify when the loop should end in Word.

Here is what I have right now: 

Sub AddFix ()

Do
Selection.MoveDown Unit:= wdline, Count:= 3
Selection.InsertParagraph
Loop Until (Selection.End = ActiveDocument.Content.End - 1)

EndSub

How do I get this sub to work through the whole document?

2
vbams-word
Welcome to SO Peckish... Well done on your first post. I've cleaned up a few minor things: Don't use "tags" in your title. Also make sure you ask a clear question. Finally, since this is to be a reference for future visitors, refrain from superfluous text. – Chrismas007
As for a possible answer: support.microsoft.com/en-us/kb/211455 Count the number of lines in the document, divide by three, and do a For x = 1 to Count of Lines CODE Next x – Chrismas007
I get that I can specify an end point via # of lines, but I was hoping to be able to write something that could be performed no matter how many lines were in the document. I haven't found anything online so far. – Peckish
Peckish, you can use my code to identify the total count of lines on a fluid document and work backwards through each line to add your blank lines. – Chrismas007

2 Answers

1
votes

Building off Chumble's answer, you will want to step backwards through your text.

Sub InsertLines()

    Dim lTotalLines As Long
    Dim lCurrentLine As Long

    lTotalLines = ActiveDocument.BuiltInDocumentProperties(wdPropertyLines)

    For lCurrentLine = lTotalLines To 3 Step -3
        Selection.GoTo What:=wdGoToLine, Which:=wdGoToAbsolute, Count:=lCurrentLine
        Selection.InsertParagraph
    Next lCurrentLine

End Sub
-1
votes

This will do what you want, however there may well be a more compact solution, this is just what I could come up with.

Sub InsertLines()

    Dim lTotalLines As Long
    Dim lCurrentLine As Long
    Dim bContinue As Boolean

    lTotalLines = ActiveDocument.BuiltInDocumentProperties(wdPropertyLines)

    If lTotalLines < 4 Then Exit Sub

    lCurrentLine = 4
    bContinue = True

    While bContinue
        Selection.GoTo What:=wdGoToLine, Which:=wdGoToAbsolute, Count:=lCurrentLine
        Selection.InsertParagraph

        lCurrentLine = lCurrentLine + 3
        lTotalLines = ActiveDocument.BuiltInDocumentProperties(wdPropertyLines)
        If lCurrentLine > lTotalLines Then bContinue = False
    Wend

End Sub