Etudes for Microsoft Word Programmers

Home ] Up ] Etude 1.1. Text Fit ] Etude 1.2. Symbol Case ] Etude 1.3. Finding and Painting Hyperlinks ] Etude 1.4. Styles ] Etude 1.5. Inserting Formatted Text ] Etude 1.6. Text in the Column. ] Etude 1.7. Formatting Headline. ]


Etude 1.6. Text in The Column

In typography, a column is one or more vertical blocks of text positioned on a page, separated by margins and/or rules. Columns are most commonly used to break up large bodies of text that cannot fit in a single block of text on a page. Additionally, columns are used to improve page composition and readability. Newspapers very frequently use complex multi-column layouts to break up different stories and longer bodies of texts within a story. Column can also more generally refer to the vertical delineations created by a typographic grid system which type and image may be positioned.

http://en.wikipedia.org/wiki/Column_(typography)

 

All of us see the horizontal and the vertical rulers that surround the document. Have you ever used it for calculating the size of a document or for selection? Is it convenient or not?

The frequent problem of the users who write paper and magazine columns is considered in this etude. It is also actual for people who create standard templates and then adjust font size and headline fonts in order to squeeze the text into the assigned space or column on a paper or magazine page. Indeed, it is not at all convenient to key in the text directly to one or several narrow columns.

The idea of calculating the text height lies in the possibility of calculating text height in any period of time on some other page, the size of which is known.

Task. Objects TextColumn and PageSetup.

It is high time to get to know the objects responsible for the arrangement of text on the page.

If you do not know the objects PageSetup, TextColumn and LineNumbering, then it is high time to learn them. Help information is as usual in Appendix. [Read!]

Resources

Template "AhTextDepth.dot", 40 Kb, ZIP [download].

Functional Specification

Task

The task is to create the "AhTextDepth.dot” template with the macros for calculating text depth and the toolbar "AhTextDepth". If there is selection, the text depth should be calculated for the selected text, otherwise the text depth should be calculated for the whole document.

Toolbar "AhTextDepth"

The toolbar "AhTextDepth" looks like this:

Brief description of the toolbar buttons is given in the table below.

Button

Macros

Description

Help

AhTextDepthHelp

Brief prompt on the toolbar buttons.

Compute

AhTextDepth

Calculation of the text depth with the given parameters.

Settings

AhTextDepthParams

Dialog for setting up the parameters for calculating text depth.

Brief Prompt

Brief prompt on the toolbar buttons looks like this:

Settings Dialog

The "Settings" dialog is used to set up settings. The dialog looks like this:

Brief settings description is given in the table below:

Setting

Description

Page Width

This is the parameter of column width for the selected text or for the whole document.
The range of permissible values [7.2-1584].
Default value 146.

Calculating Text Depth

 

To calculate text depth the Microsoft Word "Normal View" mode is set and the required page setup is set. After that the AhTextDepthPoints function moves the selection from line to line and calculates the height of a line taking into account the line spacing.

After the calculation the original view of the window is restored.

The result of the calculation is rounded up to two decimal positions and looks like this:

 

 

Usually the process of calculation goes so quickly that a user doesn’t manage to notice the switch to "Normal view" mode or the change in page setup or the selection motion between the lines of a document.

 

To look at the work of the macros given in this etude, the debugger should be used.

Implementation - Template "AhTextDepth.dot"

The function of calculating the "depth" of the text (in a column of given size) is implemented in the "AhTextDepth.dot" template. The toolbar “AhTextDepth” provides a simple interface to the calculation of text "depth".

The following modules are in the "AhTextHeadline.dot" template:

Module

Description

AhTextDepth

Basic macros.

AhTextDepthSettingsDialog

The "Settings" dialog.

 

The function of line-to-line motion across the text is found only with Selection Object. The investigated problem is a rare example of a problem that cannot be solved using only Range Object.

Module AhTextDepthSettingsDialog (Form)

The dialog of introducing additional parameters is implemented in the "AhTextDepthSettingsDialog" module. The "Settings" dialog looks like this:


'
' File AhTextDepth.dot|AhTextDepthSettingsDialog
'
' Etudes for Microsoft Word Programmers.
' Etude 1.6. Text Depth in Column.
'
' First published on http://www.transcriber.ru/
'
' © 2000-2007. Evgeny Akhundzhanov. All rights reserved.
'
Option Explicit
 

Class Members

'
' Workhorses
'
Private m_fDefaultPageWidth As Single
'
' Dialog result
'
Public dwDialogResult As Long
 

Constructor

'
' Constructor
'
Private Sub UserForm_Initialize()
    dwDialogResult = vbCancel

End Sub

Destructor

'
' Destructor
'
Private Sub UserForm_Terminate()
End Sub

"Defaults" Button Clicked

'
' Defaults
'
Private Sub btnDefault_Click()
    InitDialogData False

End Sub

"Cancel" Button Clicked

'
' Cancel
'
Private Sub btnCancel_Click()
    dwDialogResult = vbCancel
    Unload Me
End Sub

"OK" Button Clicked

'
' OK
'
Private Sub btnOK_Click()
    '
    ' set global settings
    '
    g_fDefaultPageWidth = m_fDefaultPageWidth
    
    dwDialogResult = vbOK
    Unload Me
End Sub

On Data Change

'
' Text Box Change
'
Private Sub tBox_PageWidth_Change()
    EnableControls

End Sub

Fucntion IsInRange

'
' IsInRange
'
Private Function IsInRange(ByVal fValue As Single, ByVal fMin As Single, ByVal fMax As Single) As Boolean
    If (fMin <= fValue) And (fValue <= fMax) Then
        IsInRange = True
    Else
        IsInRange = False
    End If
End Function

Procedure EnableControls

'
' EnableControls
'
Public Sub EnableControls()
Dim bEnableOk As Boolean
bEnableOk = False
On Error GoTo ErrorLabel
'
' get data from the dialog
'
m_fDefaultPageWidth = CSng(tBox_PageWidth.Text)
'
' check whether values are in valid ranges
'
If Not IsInRange(m_fDefaultPageWidth, g_fDefaultPageWidthMin, g_fDefaultPageWidthMax) Then GoTo ErrorLabel
bEnableOk = True
ErrorLabel:
btnOK.Enabled = bEnableOk
End Sub

Procedure InitDialogData

'
' InitDialogData
'
Public Sub InitDialogData(ByVal bSettingsWereSet As Boolean)
    If bSettingsWereSet Then

        '
        ' use last data
        '
        tBox_PageWidth.Text = CStr(g_fDefaultPageWidth)
    Else
        '
        ' use defaults
        '
        tBox_PageWidth.Text = CStr(g_fDefaultPageWidthDef)
    End If

    EnableControls
End Sub

Class Module AhWaitCursor

'
' File AhTextDepth.dot|AhWaitCursor
'
' Etudes for Microsoft Word Programmers.
' Etude 6. Text Depth in Column.
'
' First published on http://www.transcriber.ru/
'
' © 2000-2007. Evgeny Akhundzhanov. All rights reserved.
'
' Saves cursor in constructor, restores cursor in destructor.
'
Option Explicit

'
' Class members.
'
Private hCursor As Long
'
' Constructor
'
Private Sub Class_Initialize()
    On Error Resume Next
    CursorSave
    System.Cursor = wdCursorWait    ' set
End Sub
'
' Destructor
'
Private Sub Class_Terminate()
    On Error Resume Next
    CursorRestore
End Sub
'
' CursorSave
'
Private Sub CursorSave()
    hCursor = System.Cursor         ' save cursor
End Sub
'
' CursorRestore
'
Private Sub CursorRestore()
    System.Cursor = hCursor         ' restore cursor
End Sub

Module AhTextDepth

Macros for calculating text depth in the column of given width are situated in the "AhTextDepth" module.

'
' File AhTextDepth.dot|AhTextDepth
'
' Etudes for Microsoft Word Programmers.
' Etude 1.6. Text Depth in Column.
'
' First published on http://www.transcriber.ru/
'
' © 2000-2007. Evgeny Akhundzhanov. All rights reserved.
'
'
Option Explicit
 

Constants

'
' Constants/Parameters
'
Private Const cStrAhTextDepthHelp As String = _
"Etudes for Microsoft Word Programmers." & vbCrLf & _
"Etude 1.6. Text Depth in Column." & vbCrLf & _
"http://www.transcriber.ru" & vbCrLf & vbCrLf & _
"Template AhTextDepth.dot" & vbCrLf & vbCrLf & _
"Calculating text depth in column." & vbCrLf & vbCrLf & _
"Settings are selected from the dialog."
Private Const cbIncludeHiddenText As Boolean = False ' don't count hidden text

'
' Settings dialog data
'

'
' g_fDefaultPageWidth
'
Public g_fDefaultPageWidth As Single
Public Const g_fDefaultPageWidthMin As Single = 7.2
Public Const g_fDefaultPageWidthMax As Single = 1584
Public Const g_fDefaultPageWidthDef As Single = 146
'
' bSettingsWereSet
'
Private bSettingsWereSet As Boolean

Procedure AhTextDepthHelp

'
' AhTextDepthHelp
'
Sub AhTextDepthHelp()
    MsgBox cStrAhTextDepthHelp

End Sub

Procedure AhTextDepthParams

'
' AhTextDepthParams
'
Sub AhTextDepthParams()
    If DoAhTextDepthSettingsDialog Then
        bSettingsWereSet = True
    End If
End Sub

Procedure DoAhTextDepthSettingsDialog

'
' DoAhTextDepthSettingsDialog
'
Private Function DoAhTextDepthSettingsDialog() As Boolean
DoAhTextDepthSettingsDialog = False
'
' do settings dialog
'
Dim dlg As AhTextDepthSettingsDialog
Set dlg = New AhTextDepthSettingsDialog
With dlg
   .InitDialogData bSettingsWereSet
   .Show vbModal
   If dlg.dwDialogResult = vbOK Then
      DoAhTextDepthSettingsDialog = True
   End If
End With
Set dlg = Nothing
End Function

Procedure AhTextDepth

'
' AhTextDepth - calculates selected/document height (depth).
' Displays result in points, inches and centimeters.
'
Public Sub AhTextDepth()
Dim hei_pt As Single
Dim hei_in As Single
Dim hei_cm As Single

If Not bSettingsWereSet Then
If Not DoAhTextDepthSettingsDialog Then Exit Sub
End If

StatusBar = "Please wait..."
On Error Resume Next
Dim wc As New AhWaitCursor
hei_pt = AhTextDepthPoints(g_fDefaultPageWidth)
Set wc = Nothing
StatusBar = ""
'
' round result to 2 decimal points
'
hei_in = CDbl(CLng(PointsToInches(hei_pt) * 100)) / 100
hei_cm = CDbl(CLng(PointsToCentimeters(hei_pt) * 100)) / 100

MsgBox "Height [pt] = " & CStr(hei_pt) & vbCrLf & _
"Height [in] = " & CStr(hei_in) & vbCrLf & _
"Height [cm] = " & CStr(hei_cm)

End Sub
 

Procedure AhTextDepthPoints

'
' AhTextDepthPoints
'
Public Function AhTextDepthPoints(ByVal fDefPageWidth As Single) As Single
' fDefPageWidth [7.2 - 1584] pt
Dim fTotal, fTotalPar, fFontSize, fRealFontSize As Single
Dim fOldRightMargin, fOldLeftMargin, fOldPageWidth As Single
Dim bDocSaveStatus, bOldHyphen, bOldCaps, bFirstLine, bFirstPar As Boolean
Dim bIsSelection, bRestoreSelection As Boolean

Dim c, dwCharCount, dwAlerts, dwOldZone, dwOldLimits, dwSelectionPrev, dwOldView As Long
Dim iSelStartEnd, dwOldSStart, dwOldSEnd As Long

Dim ParRange, DocRange As Range
Dim Par As Paragraph

    AhTextDepthPoints = 0
    If Documents.Count <= 0 Then Exit Function
    '
    ' Application
    '
    dwAlerts = Application.DisplayAlerts
    Application.DisplayAlerts = wdAlertsNone
    Application.ScreenUpdating = False
    '
    ' View
    '
    dwOldView = ActiveDocument.ActiveWindow.View.Type
    ActiveDocument.ActiveWindow.View.Type = wdNormalView
   
    bDocSaveStatus = ActiveDocument.Saved
   
    Debug.Print "AhTextDepthPoints +++"
   
    With Selection
    '
    ' save selection
    '
    If .Start = .End Then
        bRestoreSelection = True
        bIsSelection = False
        iSelStartEnd = .Start
        .WholeStory
        Debug.Print "WholeStory Selection [" & .Start & ";" & .End & "]"
        Set DocRange = .Range
    Else
        bRestoreSelection = False
        bIsSelection = True
        Set DocRange = ActiveDocument.Range(Start:=.Start, End:=.End)
    End If
    '
    ' don't count hidden text
    '
    DocRange.TextRetrievalMode.IncludeHiddenText = cbIncludeHiddenText

    dwOldSStart = .Start
    dwOldSEnd = .End

    End With
   
    '
    ' set indents
    '
    With DocRange.ParagraphFormat
        .RightIndent = 0
        .LeftIndent = 0
    End With
   
    '
    ' page setup, page width
    '
    With ActiveDocument
        bOldHyphen = .AutoHyphenation
        bOldCaps = .HyphenateCaps
        dwOldZone = .HyphenationZone
        dwOldLimits = .ConsecutiveHyphensLimit
        .AutoHyphenation = True
        .HyphenateCaps = True
        .HyphenationZone = InchesToPoints(0.1)
        .ConsecutiveHyphensLimit = 0
       
        With .PageSetup
            fOldRightMargin = .RightMargin
            fOldLeftMargin = .LeftMargin
            fOldPageWidth = .PageWidth
            .LeftMargin = 0
            .RightMargin = 0
           
            On Error GoTo ErrPageWidth
            .PageWidth = fDefPageWidth
           
            On Error GoTo 0
        End With
    End With
   
    Selection.HomeKey Unit:=wdStory
  
    bFirstLine = True
    bFirstPar = True
  
    Dim nPara, nPars As Long
    nPara = 0
    nPars = DocRange.Paragraphs.Count
    Debug.Print "Processing paragraphs: ", nPars
  
    Dim ahRangeStr As String
    Dim ahRangeLen As Long
   
    For Each Par In DocRange.Paragraphs
        nPara = nPara + 1
       
        ahRangeStr = Par.Range.Text
        ahRangeLen = Len(ahRangeStr)
       
        Debug.Print "Processing paragraph ", nPara, " Range = [", Par.Range.Start, ";", Par.Range.End, "]. Len = ", ahRangeLen
       
        With Selection
       
        .Start = Par.Range.Start
        fTotalPar = 0
       
        '
        ' Move selection line by line
        '
        Do
            .MoveEnd Unit:=wdLine, Count:=1 ', Extend:=wdExtend
     
            If .Font.Size = wdUndefined Then
            ' means we have different fonts on this line
                fFontSize = 0
                dwCharCount = .Characters.Count
                For c = 1 To dwCharCount
                    With .Characters(c).Font
                    If (.Hidden <> True) Then
                        If .Size > fFontSize Then
                            fFontSize = .Size
                        End If
                    End If
                    End With
                Next
            Else
              fFontSize = .Font.Size
            End If
            
            fRealFontSize = fFontSize
                  
           
            If .Font.Hidden <> True Then
                If Not bFirstLine Then
                    Select Case Par.LineSpacingRule
                        Case wdLineSpaceSingle
                            fFontSize = fFontSize * 1
                        Case wdLineSpace1pt5
                            fFontSize = fFontSize * 1.5
                        Case wdLineSpaceDouble
                            fFontSize = fFontSize * 2
                        Case wdLineSpaceAtLeast, wdLineSpaceExactly
                            fFontSize = Par.LineSpacing * 1#
                        Case wdLineSpaceMultiple
                            fFontSize = Par.LineSpacing * fFontSize
                    End Select
                End If
                fTotalPar = fTotalPar + fFontSize
                bFirstLine = False
            End If
           
            If .End >= DocRange.End Then Exit Do
           
            dwSelectionPrev = .Start
           
            ' skip empty paragraph
            If (ahRangeLen <= 1) Then Exit Do
           
            .GoToNext wdGoToLine     ' hangs on empty paragraph
           
            '
            ' check loop conditions
            '
            If (dwSelectionPrev = .Start) Then Exit Do
            If (.Start >= Par.Range.End) Or (.Start + 1 >= DocRange.End) Then Exit Do
        Loop
   
        '
        ' count paragraph
        '
        If fTotalPar <> 0 Then
             If bFirstPar Then
                fTotal = fTotal + fTotalPar + Par.SpaceAfter
                bFirstPar = False
             Else
                fTotal = fTotal + fTotalPar + Par.SpaceAfter + Par.SpaceBefore
             End If
        End If
       
        End With
    Next Par
   
    '
    ' Cut off "space before" for first paragraph
    ' and "space after" for last paragraph.
    '
    fTotal = fTotal - DocRange.Paragraphs.Last.SpaceAfter
   
    '
    ' restore view and page setup
    '
    With Selection
        .Start = dwOldSStart
        .End = dwOldSEnd
    End With
   
    With ActiveDocument
        .ActiveWindow.View.Type = dwOldView
        On Error Resume Next
        .AutoHyphenation = bOldHyphen
        .HyphenateCaps = bOldCaps
        .HyphenationZone = dwOldZone
        .ConsecutiveHyphensLimit = dwOldLimits
        On Error GoTo 0
        With .PageSetup
             .PageWidth = fOldPageWidth
             .RightMargin = fOldRightMargin
             .LeftMargin = fOldLeftMargin
        End With
        .Saved = bDocSaveStatus 'make sure we didn't make it dirty
    End With
    '
    ' restore Application properties
    '
    Application.ScreenUpdating = True
    Application.DisplayAlerts = dwAlerts
   
    AhTextDepthPoints = fTotal
    '
    ' restore selection
    '
    If bRestoreSelection Then
        Selection.SetRange iSelStartEnd, iSelStartEnd
    End If
   
    Debug.Print "AhTextDepthPoints =="
    Exit Function
   
ErrPageWidth:
    '
    ' Page setup error.
    '
    MsgBox "Error in AhTextDepthPoints. " & _
            "Column width = " & CStr(fDefPageWidth) & " is out of range." & vbCrLf & _
            "The calculated text depth could be incorrect." & vbCrLf & vbCrLf & _
            Err.Description
    Resume Next
End Function

Conclusions

Operations with calculating text depth are investigated in this chapter.

The "AhTextDepth.dot" template was created on the basis of specification. It contains macros for calculating text depth in the column of given width and the dialog for setting up the required parameters. The toolbar "AhTextDepth" provides a simple interface to the operations of calculating text depth and setting up the required parameters.

Tasks

Task 1

The given code works wrong if the text contains hyperlinks. Why, do you understand? Improve the macros code so that the depth of the text with hyperlinks should be calculated correctly.

 

Task 2

The given code doesn’t work correctly if line spacing doesn't set up for a paragraph, but set up for font("Character Spacing" bookmark  of the "Font"  dialog in the "Format" menu ) . Change the macros code so that text depth in this case should be calculated correctly.

 

 


Etudes for Microsoft Word Programmers.
Etude 1.6. Text in the Column.


Unless otherwise noted, all materials on this site are
© 2000-2009 Evgeny Akhundzhanov, All Rights Reserved Worldwide
Microsoft is in no way affiliated with, nor offers endorsement of, this site.
www.transcriber.ru | E-mail the Author