Formatting content between headings into two columns

[sbrbot]

I've got a Word document with the following content;

Heading level 1
Heading level 2
Heading level 3
A text paragraph that should be formatted (including Headings of 3rd level)
Heading level 3
A text paragraph that should be formatted (including Headings of 3rd level)
Heading level 3
A text paragraph that should be formatted (including Headings of 3rd level)
Heading level 2
Heading level 3
A text paragraph that should be formatted (including Headings of 3rd level)
Heading level 3
A text paragraph that should be formatted (including Headings of 3rd level)
Heading level 1
Heading level 2
Heading level 3
A text paragraph that should be formatted (including Headings of 3rd level)

I need a macro which would pass through this whole document content and format content of text paragraphs (including Headings of level 3) colored red into two columns. Of course, there's no constant number of paragraphs inside Headings and there's no constant number lower level headings inside upper level headings.

How to do that?

[sbrbot]

OK, this is my code. It works. It formats Heading 3 content in two equal columns.


Sub FormatH3ContentIntoColumns()

Dim lineNo As Long ' line number
Dim rangeStart As Long ' range start point
Dim rangeEnd As Long ' range end point
Dim rangeObj As range ' range object

' goto the beginning of document text
Selection.GoTo What:=wdGoToLine, Which:=wdGoToAbsolute, Count:=1

Do
' start counting lines
lineNo = Selection.range.Information(wdFirstCharacterLineNumber)
Selection.MoveDown Unit:=wdLine, Count:=1

' find a line with H3
If Selection.Style = ActiveDocument.Styles(wdStyleHeading3) Then
' this is start of text range that should be columned
rangeStart = Selection.Start

' proceed until next H2, H1 or EOF found
Do
lineNo = Selection.range.Information(wdFirstCharacterLineNumber)
Selection.MoveDown Unit:=wdLine, Count:=1
rangeEnd = Selection.Start
Loop Until Selection.Style = ActiveDocument.Styles(wdStyleHeading2) _
Or Selection.Style = ActiveDocument.Styles(wdStyleHeading1) _
Or lineNo = Selection.range.Information(wdFirstCharacterLineNumber)
' if we reached next H2,H1 or EOF this is end of text range that should be columned

Set rangeObj = ActiveDocument.range(Start:=rangeStart, End:=rangeEnd)
' if one wants columns of text segment it should be separated by continuous breaks
rangeObj.InsertBreak Type:=wdSectionBreakContinuous
Selection.InsertBreak Type:=wdSectionBreakContinuous
' format it into two equal columns
With rangeObj.PageSetup.TextColumns
.SetCount NumColumns:=2
.EvenlySpaced = True
.LineBetween = False
.Width = CentimetersToPoints(7.5)
.Spacing = CentimetersToPoints(1)
End With
End If

Loop While lineNo <> Selection.range.Information(wdFirstCharacterLineNumber)

End Sub


As you can see from this code, I test if I reached the end of file (EOF) by comparing if current line number of cursor is the same with the line number after I try to move to next line (Section.MoveDown). There has to be more elegant way for this!?

Can you suggest any other way for looping through document line by line and exit from loop when EOF is reached?

[sbrbot]

There is one approach for looping through the whole document:

Do Until ActiveDocument.Bookmarks("\Sel") = ActiveDocument.Bookmarks("\EndOfDoc")
'(Do something)
Loop


This approach uses internal hardcoded Word document bookmarks but this is also dirty programming.