Change two columns to one column?

Question

I am composing a word.doc using access VBA. Doc starts in one column. I split the next section into 3 columns using:

.InsertBreak wdSectionBreakContinuous
    With w.ActiveDocument.Sections(2).PageSetup.TextColumns
        .SetCount numcolumns:=2
        .Add EvenlySpaced:=True
    End With

Then I split to 2 columns using:

.InsertBreak wdSectionBreakContinuous
With w.ActiveDocument.Sections(3).PageSetup.TextColumns
    .SetCount numcolumns:=1
    .Add EvenlySpaced:=True
End With

Now I want to go back to a single column, but the following:

.InsertBreak wdSectionBreakContinuous
w.ActiveDocument.Sections(4).PageSetup.TextColumns.SetCount numcolumns:=0

does not work. Any tips on how to convert back to a single column? FWIW all of this happens on a single page in word.

Thanks!

Answer 1

You need at least to use

w.ActiveDocument.Sections(4).PageSetup.TextColumns.SetCount numcolumns:=1

rather than numcolumns:=0

Here, using numcolumns:=1 raises error 5148 "The number must be between 1 and 45", which suggests that you may have switched off error checking while testing your code.

Also, if you compare with your first two pieces of code, you are

• setting the number of columns to 2, then Adding a column to make 3
• setting the number of columns to 1, then Adding a column to make 2

whereas in your third piece of code you aren't Adding a column, suggesting that you would need in any case to set the count to 1 rather than 0.

Answer 2

This works for me:

Sub ColumnsDemo()
Dim Rng As Range
With ActiveDocument
  With .Sections(1)
    .PageSetup.TextColumns.SetCount NumColumns:=1
    Set Rng = .Range.Paragraphs(10).Range
    Rng.Collapse
    Rng.InsertBreak wdSectionBreakContinuous
  End With
  With .Sections(2)
    With .PageSetup.TextColumns
      .SetCount NumColumns:=2
      .EvenlySpaced = True
      .LineBetween = False
    End With
    Set Rng = .Range.Paragraphs(10).Range
    Rng.Collapse
    Rng.InsertBreak wdSectionBreakContinuous
  End With
  With .Sections(3)
    With .PageSetup.TextColumns
      .SetCount NumColumns:=3
      .EvenlySpaced = True
    End With
    Set Rng = .Range.Paragraphs(10).Range
    Rng.Collapse
    Rng.InsertBreak wdSectionBreakContinuous
  End With
  With .Sections(4)
    With .PageSetup.TextColumns
      .SetCount NumColumns:=2
      .EvenlySpaced = True
      .LineBetween = False
    End With
    Set Rng = .Range.Paragraphs(10).Range
    Rng.Collapse
    Rng.InsertBreak wdSectionBreakContinuous
  End With
  With .Sections(5)
    .PageSetup.TextColumns.SetCount NumColumns:=1
  End With
End With
End Sub