none
Page Layout in multi-column documents RRS feed

  • Question

  • Hello all experts,

    I'm dealing with is page layout in multi-column documents, since Word is not a desktop publishing solution, it doesn't have a built-in option to align all columns equally at the bottom, and therefore I have to do it manually. I'm using a function to find the difference in points between two columns, the trouble is it doesn't always work, sometimes it will return a value of several hundred points when there hardly is a difference at all.

    I'm posting the function here; I would appreciate any help I can get in solving the mystery, and or improve the function.

    Function ColumnDiff()
    
      Dim i As Integer, iCounter As Integer, iPos As Long, iPosCol As Long
      Dim iCol() As Currency, nCol As Integer
      Dim myRange As Range, iViewType As Integer, bEnd As Boolean
      
      Const MaxDiff = 0 ' difference (in points) for the function to ignore
      
      If Selection.StoryType <> 1 Then MsgBox "Cursor not in main text!": Exit Function
      Set myRange = Selection.Range
      Application.ScreenUpdating = False
      iViewType = ActiveWindow.View.Type: ActiveWindow.View.Type = wdPrintView
      iPos = -1
      With Selection
          .Collapse wdCollapseEnd
          iCounter = iCounter + 1: StatusBar = iCounter
          While iPos < .Start
    X2:       iPos = .Start
              If Dialogs(wdDialogFormatColumns).Columns = 1 Then GoTo X0
              ReDim iCol(Dialogs(wdDialogFormatColumns).Columns + 1)
              iPosCol = iPos: iPos = iPos - 1: nCol = 0
              While iPos < .Start
                  iPos = .Start
                  If Dialogs(wdDialogFormatColumns).Columns = 1 _
                      Or Dialogs(wdDialogFormatColumns).ColumnNo < nCol _
                      Then GoTo X1
                  nCol = Dialogs(wdDialogFormatColumns).ColumnNo
                  iCol(nCol) = .Information(wdVerticalPositionRelativeToPage)
                  .GoToNext wdGoToLine
                  iCounter = iCounter + 1: StatusBar = iCounter
              Wend
              bEnd = True: iPos = ActiveDocument.StoryRanges(1).End
    X1:       For i = 1 To nCol ' iCol(0) = high peak
                  If iCol(0) < iCol(i) Then iCol(0) = iCol(i)
              Next i
              iCol(nCol + 1) = iCol(0) ' iCol(nCol + 1) = low peak
              For i = 1 To nCol
                  If iCol(nCol + 1) > iCol(i) Then iCol(nCol + 1) = iCol(i)
              Next i
              If iCol(0) - iCol(nCol + 1) > MaxDiff Then
                  .SetRange iPosCol, iPos
                  Application.ScreenUpdating = True
                  ColumnDiff = CCur(iCol(0) - iCol(i)) ' & "pt"
                  Exit Function
              End If
              If bEnd Then GoTo X3 Else GoTo X2
    X0:       .GoToNext wdGoToLine
              iCounter = iCounter + 1: StatusBar = iCounter
          Wend
      End With
    X3:   myRange.Select
          Application.ScreenUpdating = True: ActiveWindow.View.Type = iViewType
          MsgBox "Done!"
      
      End Function

    Limitations of the function:

    1. The function will only find the difference in the main text and not in footnotes etc.

    2. The function starts searching from the cursor location (or the end of the selected text) till the end of the document.

    Related Question:

    http://social.msdn.microsoft.com/Forums/en-US/worddev/thread/79855849-4809-4777-8a47-2dec56a1313c


    • Edited by moishy Wednesday, February 15, 2012 1:29 PM
    Wednesday, February 15, 2012 1:25 PM

Answers

  • Ended up using my function. Turns out that for some (unknown) reason if the cursor wasn't in the first column it would compare the the column of the (collapsed) selection to an empty column. The resolution of the problem was to move the selection to the first column on page before any further processing.
    • Marked as answer by moishy Friday, May 4, 2012 1:28 PM
    Friday, May 4, 2012 1:28 PM

All replies

  • You can balance columns at the bottom of a page by inserting a continuous section break at the end of the page. But Word does this by moving entire lines between the columns, it doesn't adjust line spacing. If the total number of lines is odd, you'll be stuck with a difference of 1 line between the columns. Widow/orphan control also affects the result.

    Regards, Hans Vogelaar

    Wednesday, February 15, 2012 3:01 PM
  • I do all of that, this function is used to help me align all columns equally at the bottom.
    Wednesday, February 15, 2012 6:33 PM
  • Hi Moishy,

    Try something based on the following, which returns the count of the last word in each column and the distance from the top of the page to that word. Note that you don't have to actually have anything selected - the macro works with the whatever page & Section the insertion point is in.

    Sub ColumnTest()
    Dim Rng As Range, StrDat As String, i As Long, j As Long, k As Long, s As Single, t As Single
    With Selection
      .Collapse wdCollapseEnd
      Set Rng = .Range
      Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page")
      With Rng
        If .Sections.Count > 1 Then
          If .Start < Selection.Sections(1).Range.Start Then .Start = Selection.Sections(1).Range.Start
          If .End > Selection.Sections(1).Range.End Then .End = Selection.Sections(1).Range.End
        End If
        If .PageSetup.TextColumns.Count = 1 Then Exit Sub
        i = .Words.Count
        For j = i To 1 Step -1
          s = .Words(j).Characters.First.Information(wdVerticalPositionRelativeToPage)
          If s > t Then
            StrDat = j & vbTab & s & vbCr & StrDat
          End If
          t = s
        Next
        StrDat = "Word" & vbTab & "VPos" & vbCr & StrDat
        MsgBox StrDat
      End With
    End With
    End Sub


    Cheers
    Paul Edstein
    [MS MVP - Word]

    Thursday, February 16, 2012 4:33 AM
  • Thanks Paul,

    That approach may work better but it definitely works a lot slower.

    How can your macro be changed so the msgBox will show which column is longer and the difference in points?

    Thursday, February 16, 2012 5:19 AM
  • That approach may work better but it definitely works a lot slower.

    How can your macro be changed so the msgBox will show which column is longer and the difference in points?

    You might be able to speed things up dramatically, by testing at the para level first, then at the sentence level before working at the word level. Added logic would be required for paragraphs & sentences that start & end in different columns.

    If you have a page with, say, 5 columns, they could all have different heights, so which value(s) should be reported? Trying to balance them automatically can be quite problematic, especially if there are non-text elements on the page that the text has to wrap around. In that case, you might also want to micro-adjust the positions of the non-text elements and the white space around them.


    Cheers
    Paul Edstein
    [MS MVP - Word]

    Thursday, February 16, 2012 5:30 AM
  • You might be able to speed things up dramatically, by testing at the para level first, then at the sentence level before working at the word level. Added logic would be required for paragraphs & sentences that start & end in different columns.

    If you have a page with, say, 5 columns, they could all have different heights, so which value(s) should be reported? Trying to balance them automatically can be quite problematic, especially if there are non-text elements on the page that the text has to wrap around. In that case, you might also want to micro-adjust the positions of the non-text elements and the white space around them.


    Sounds interesting, how would I deal with lines or paragraphs spanning over more than one column?

    If there are only two columns I would like a msgbox reporting:
    "col x is longer that col y by xx pts"

    If there are more that two columns I would like a msgbox reporting:
    "col #1 ends at xx pts from beginning of col, col #2 ends at xx pts from beginning of col, col #3 ends at xx pts from beginning of col" etc.

    Thanks for you assistance.
    Thursday, February 16, 2012 6:17 AM
  • Hi Moishy,

    Try something along the lines of:

    Sub ColumnTest()
    Application.ScreenUpdating = False
    Dim Rng As Range, oPara As Paragraph, RngPara As Range, StrDat As String
    Dim i As Long, s As Single, t As Single, u As Single, v As Single, w As Single
    With Selection
      .Collapse wdCollapseEnd
      Set Rng = .Range
      Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page")
      With Rng
        If .Sections.Count > 1 Then
          If .Start < Selection.Sections(1).Range.Start Then .Start = Selection.Sections(1).Range.Start
          If .End > Selection.Sections(1).Range.End Then .End = Selection.Sections(1).Range.End
        End If
        With .PageSetup
          If .TextColumns.Count = 1 Then Exit Sub
          i = 1
          w = .TextColumns(i).Width + .LeftMargin
        End With
        For Each oPara In .Paragraphs
          Set RngPara = oPara.Range
            With RngPara
              If .End >= Rng.End Then
                .End = Rng.End
                GoTo Final
              End If
              If .Words.First.Information(wdHorizontalPositionRelativeToPage) > w Then
                .Start = .Start - 1
                While .Characters.First Like "[0-9A-Za-z]" = False
                  .MoveStart wdCharacter, -1
                Wend
                  .MoveStart wdWord, -1
              End If
              If .Words.Last.Characters.First.Information(wdHorizontalPositionRelativeToPage) > w Then
                While .Sentences.Last.Characters.First.Information(wdHorizontalPositionRelativeToPage) > w
                  .MoveEnd wdSentence, -1
                Wend
                .Start = .Sentences.Last.Start
                While .Words.Last.Information(wdHorizontalPositionRelativeToPage) > w
                  .MoveEnd wdWord, -1
                Wend
                With .PageSetup
                  i = i + 1
                  w = w + .TextColumns(i - 1).SpaceAfter + .TextColumns(i).Width
                End With
    Final:
                While .Characters.Last Like "[0-9A-Za-z]" = False
                  .MoveEnd wdCharacter, -1
                Wend
                s = .Words.Last.Characters.First.Information(wdVerticalPositionRelativeToPage)
                If StrDat = "" Then u = s
                v = Round((s - u) * 10) / 10
                StrDat = StrDat & vbCr & .Words.Last & vbTab & s & vbTab & vbTab & v
                t = s
              End If
            End With
        Next
        StrDat = "Word" & vbTab & "VPos" & vbTab & "Rel. Offset" & StrDat
        MsgBox StrDat
      End With
    End With
    Set Rng = Nothing: Set RngPara = Nothing
    Application.ScreenUpdating = True
    End Sub

    The above macro reposrts the last word in each column, the vertical position of the last word and the difference between that and the first column. As you can see, to gain the extra speed, the above version is far more complex than the previous one.


    Cheers
    Paul Edstein
    [MS MVP - Word]


    • Edited by macropodMVP Sunday, February 19, 2012 10:37 AM
    Sunday, February 19, 2012 10:35 AM
  • Paul,

    Thank you, but I can't get it to work. There are several problems depending on the document (and language) I try it on, sometimes I get a "Code execution has been interrupted" highlighting different lines, sometimes it will get stuck (all I see is a hourglass) and sometimes I get an error telling me I can't set margins after... (I don't remeber the exact error, the error showed up in a critical msgbox).

    Sunday, February 19, 2012 1:37 PM
  • Without more details, it's rather hard to diagnose based on the information given. I'd need to know what lines are generating particular errors, and under what scenarios. In any event, given that you're unlikely to be doing this a great deal in a given document, do you really need to extra speed?

    Cheers
    Paul Edstein
    [MS MVP - Word]

    Sunday, February 19, 2012 9:49 PM
  • The speed is very important; I will be doing some heavy usage with this macro.

    I'll try to do some extensive testing and we'll see what I come up with.

    Monday, February 20, 2012 6:20 AM
  • I did some testing and here are my findings:

    1. The code never produced an error message, it breaks on different lines, usually every consective time the macro was ran it would break on a different line, sometimes completing the code (showing the message box, but after ok was clicked it would break on "End With" after "MsgBox StrDat")

    2. The line the code would break on would depend what number time the macro was ran and witch page the cursor was on. I tested the macro on the first 6 pages of an 11 page document, here are the details:

    Aligned to center, cursor in first column in document:

    .MoveEnd wdSentence, -1

    Aligned to center, cursor in second or forth column in document:

    .MoveStart wdWord, -1
    End If

    Aligned to center, cursor in third column in document:

    .MoveEnd wdWord, -1

    Aligned to center, cursor in fourth column in document: 

    1. w = w + .TextColumns(i - 1).SpaceAfter + .TextColumns(i).Width
        End With

    2. t = s
        End If

    3. .MoveStart wdWord, -1
        End If

    4. .MoveEnd wdWord, -1

    5. .Start = .Sentences.Last.Start

    Aligned to center, cursor in fifth column in document: 

    1. t = s
        End If

    2. .MoveEnd wdSentence, -1

    3. w = .TextColumns(i).Width + .LeftMargin
        End With

    4. .MoveEnd wdWord, -1

    5. .MoveStart wdWord, -1
         End If

    Aligned to center, cursor in sixth column in document: 

    1. w = w + .TextColumns(i - 1).SpaceAfter + .TextColumns(i).Width
    End With

    .2. MoveEnd wdWord, -1

    3. .Start = .Sentences.Last.Start

    4. While .Sentences.Last.Characters.First.Information(wdHorizontalPositionRelativeToPage) > w

     

    Monday, February 20, 2012 7:28 PM
  • Hi Moishy,

    Before I can make sense of any of the above, I'd need to see the document in question. If you could upload a copy (without anything sensitive) to one of the many file hosting sites, and paste a link here, I'll be able to do some testing/debugging with it.


    Cheers
    Paul Edstein
    [MS MVP - Word]

    Tuesday, February 21, 2012 4:36 AM
  • Here you go:

    https://rapidshare.com/files/2358477228/PageLayout.doc

    Tuesday, February 21, 2012 9:41 AM
  • Hi Moishy,

    I see your document is in right-to-left format - a vital piece of information you haven't mentioned before. That's probably what's behind the errors you're encountering. As I've not worked with one of these before, it may take a while to re-work the code.


    Cheers
    Paul Edstein
    [MS MVP - Word]

    Wednesday, February 22, 2012 1:53 AM
  • Hi Moishy,

    As I don't ahve a left-to-right system to test with. I suspect the issue may have something to do with the way Word interprets the various MoveStart & MoveEnd paramenters in the code. Try replacing the '-1' with 'wdBackward' in all these lines:
    .MoveStart wdCharacter, -1
    .MoveStart wdWord, -1
    .MoveEnd wdSentence, -1
    .MoveEnd wdWord, -1
    .MoveEnd wdCharacter, -1


    Cheers
    Paul Edstein
    [MS MVP - Word]

    Tuesday, March 27, 2012 5:56 AM
  • Thanks for bearing with me.

    I did what you suggested, now the code gets stuck in a infinite loop at

    While .Sentences.Last.Characters.First.Information(wdHorizontalPositionRelativeToPage) > w
          .MoveEnd wdSentence, wdBackward
    Wend
    

    btw, should .LeftMargin in the following line be changed to .RightMargin?

    w = .TextColumns(i).Width + .LeftMargin
    

    Wednesday, March 28, 2012 9:29 PM
  • Ended up using my function. Turns out that for some (unknown) reason if the cursor wasn't in the first column it would compare the the column of the (collapsed) selection to an empty column. The resolution of the problem was to move the selection to the first column on page before any further processing.
    • Marked as answer by moishy Friday, May 4, 2012 1:28 PM
    Friday, May 4, 2012 1:28 PM