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.7. Formatting Headline

When you pick up a newspaper, watch a show or news, listen to the radio it will be the headlines that grab your attention first especially if it relates to something you want or have been looking for.

http://discuss.joelonsoftware.com/default.asp?biz.5.464080.19

Resources

Template "AhTextHeadline.dot", 59 Kb, ZIP [download].

 


Functional Specification

Task

Headline formatting (adjusting headline size and style) is used when the headline should be adjusted to the rectangle of the given size. Let us take for granted that the number of lines and headline width are also of given size.

If you create a headline in the current text then you select the text of the headline and press the "Headline" button. If you press the "Headline" button without selecting any text then the fictitious headline of given size appears and you can key in the headline text later.

Pressing the "Headline" button switches on the headline formatting mode ("Headline On"). Pressing the "Headline" button again switches the headline formatting mode off ("Headline Off").

In "Headline On" mode the Microsoft Word window turns to the mode "maximized" where the right and the left borders of the headline are printed/seen/reflected in blue color.

In "Headline Off" mode the initial Microsoft Word window mode is restored, the right and the left borders of the headline are not reflected.

 

Headline Formatting Settings

The following parameters/settings are used for headline formatting:

Setting

Type

Comment

Width

integer

Headline width in points.

Value range [100-600].

Number of Lines

integer

The number of lines.

Value range [1-4].

Filling Character

Symbol

Filling Character is used for the creation of fictitious headlines.
It is defined in the module text as string constant.

Style

String

Style name.

The initial setting values are set in the module code as constants. To change the constants the AhTextHeadlineSettingsDialog dialog is used, which is called before the "Headline On" mode switches on.

 

Ïàíåëü èíñòðóìåíòîâ "AhTextHeadline"

The "AhTextHeadline" toolbar looks like this:

The brief description of the "AhTextHeadline" toolbar buttons is given in the following table.

Button

Description

Help

Brief prompt.

Headline

Adjusting the headline size.

On the first click the headline formatting mode switches on, the frame of a fixed size is reflected.

On the next click the headline formatting mode switches off and the normal editing mode/text formatting mode is restored.

Styles

Creation of the styles "HeadlineStyle1" and " HeadlineStyle2".

The styles are used for headlines.

 

Brief Prompt

The brief prompt on the toolbar buttons looks like this.

 

Styles Creation

On pressing the "Styles" button two styles, "HeadlineStyle1" and "HeadlineStyle2", are created. They are used in headline formatting. If at least one of the styles already exists, then the message appears and the existing styles are not changed.

Dialog "Headline settings"

The "Headline settings" dialog is used for entering the settings for headline formatting. It looks like this. To facilitate the choice of the style only the styles the name of which starts with "Headline" are reflected in the list "Headline styles".

Headline Formatting based on the Selection

To format the headline on the basis of the selection:

1. select the text of the headline
2.
press the button "Headline" to switch on the headline formatting mode

In the dialog “Choose the Headline Style” choose the necessary style, set the number of lines and the headline width and press the “OK” button.

The headline formatting mode will switch on. The right and the left borders of the preset rectangle will be painted blue. On pressing the button “Cancel” the headline formatting mode will not switch on.

The selected headline will be reformatted according to the selected settings. The text which does not fit into the rectangle of the preset size will be painted red.

 

 

 

The user may cut or lengthen the headline text, change the font size or change the spacing in order to fit the headline into the preset/given rectangle.

 

If you type the text in headline formatting mode the text which does not fit into the rectangle will not be colored red. It will be colored red later, when you finish keying in.

 

 

To make sure that the changed headline fits into the preset rectangle the user should quit the headline formatting mode, select the changed text and repeat the described procedure.

 

 

On pressing the "Headline" button again the headline formatting mode is switched off. The borders are not painted blue.

 

Creating Fictitious Headline

To create a fictitious headline the user should set the cursor to the necessary place and press the “Headline” button without selecting any text in advance.

In the dialog “Choose the Headline Style” the user chooses the necessary style and other settings. In case the “Cancel” button is pressed the headline formatting mode is not switched on. After pressing the “OK” button the headline formatting mode is switched on. The borders of the preset rectangle are painted blue and the preset rectangle is filled with the repeated symbol of the filling (constant).

 

Automatically created fictitious headline is displayed on the picture below.

 

The user types in the necessary text in place of fictitious or delays keying in. On keying in the text the user should try to keep the preset number of lines and fit the headline into the preset rectangle. To make sure that the keyed in or changed headline fits into the preset rectangle the user repeats the described procedure as long as it is necessary.

The skill of working with bookmarks is useful in implementing the set task. Let us study the properties and methods of the object Bookmark and the collection Bookmarks at first .

 

Implementation. Template "AhTextHeadline.dot"

The “AhTextHeadline” template contains the following modules:

Module

Description

AhTextHeadline

Basic macros.

zAhHeadlineStyles

Styles creation. The source codes of this module are not given in this book.

AhTextHeadlineSettingsDialog

"Headline Settings" dialog.

 

Module AhTextHeadlineSettingsDialog

The “Headline settings” Format Settings dialog is implemented in the “AhTextHeadlineSettingsDialog” module. The "Headline settings" dialog looks like this.

Class Members

'
' File AhTextHeadline.dot|AhTextHeadlineSettingsDialog
'
' Etudes for Microsoft Word Programmers.
' Etude 1.7. Headlines.
'
' First published on http://www.transcriber.ru
'
' © 2000-2007. Evgeny Akhundzhanov. All rights reserved.
'
'
Option Explicit
'
' Declarations
'
Public dwDialogResult As Long   ' return value

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

End Sub

Constructor

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

End Sub

Destructor

'
' Destructor
'
Private Sub UserForm_Terminate()
End Sub

Procedure InitDialogData

'
' InitDialogData
'
Public Sub InitDialogData(ByVal bInUseOnly As Boolean, ByVal bHeadlineStylesOnly As Boolean)
Dim styl As style
Dim bAddStyle As Boolean

    For Each styl In ActiveDocument.Styles
        '
        ' determine whether to add styl or not
        '
        bAddStyle = False
        If bInUseOnly Then
            If styl.InUse Then
                bAddStyle = True
            End If
        Else
            bAddStyle = True
        End If
        
        If bHeadlineStylesOnly Then
            If styl.NameLocal Like "Headline*" Then
                bAddStyle = True
            Else
                bAddStyle = False
            End If
        End If
        '
        ' add style name to combo box
        '
        If bAddStyle Then
            m_cboxStyles.AddItem styl.NameLocal
        End If
    Next styl
   
    m_tBox_Width.Text = "400"
   
m_tbox_nLines.Text = "2"
   
End Sub

Procedure EnableControls

'
' EnableControls
'
Public Sub EnableControls()
    '
    ' enable Create button depending on m_cboxStyles.ListCount
    '
    Dim iStylesCnt As Long
    iStylesCnt = m_cboxStyles.ListCount
    If iStylesCnt > 0 Then
        m_btnCreate.Enabled = False
        m_btnCreate.Visible = False
        m_btnOK.Enabled = True
    Else
        m_btnOK.Enabled = False
        m_cboxStyles.Enabled = False
    End If
   
       
    If iStylesCnt > 0 Then
        m_cboxStyles.ListIndex = 0
    Else
        m_cboxStyles_Change ' forces valid description
    End If
   
    If m_btnOK.Enabled = False Then Exit Sub
   
    '
    ' check text box (m_tBox_Width)
    '
    If Len(m_tBox_Width.Text) > 0 Then
        g_dwWidthInPoints = CLng(m_tBox_Width.Text)
        If 100 <= g_dwWidthInPoints And g_dwWidthInPoints <= 600 Then
            ' g_dwWidthInPoints is valid
        Else
            m_btnOK.Enabled = False
            Exit Sub
        End If
    Else
        m_btnOK.Enabled = False
        Exit Sub
    End If
   
    '
    ' check text box (m_tbox_nLines)
    '
    If Len(m_tbox_nLines.Text) > 0 Then
        g_dwNumberOfLines = CLng(m_tbox_nLines.Text)
        If 1 <= g_dwNumberOfLines And g_dwNumberOfLines <= 4 Then
            ' g_dwNumberOfLines is valid
        Else
            m_btnOK.Enabled = False
            Exit Sub
        End If
    Else
        m_btnOK.Enabled = False
       
Exit Sub
    End If
   
End Sub

Pressing "Cancel" Button

'
' Cancel button clicked
'
Private Sub m_btnCancel_Click()
    dwDialogResult = vbCancel
    Unload Me
End Sub

Pressing "OK" Button

'
' OK button clicked
'
Private Sub m_btnOK_Click()
    dwDialogResult = vbOK
    g_strSelectedStyle = m_cboxStyles.Text
    g_dwSelectedStyleIndex = m_cboxStyles.ListIndex
    g_dwWidthInPoints = CLng(m_tBox_Width.Text)
    g_dwNumberOfLines = CLng(m_tbox_nLines.Text)
    Unload Me
End Sub
 

Pressing "Create" Button

'
' Create
'
Private Sub m_btnCreate_Click()
    dwDialogResult = vbCancel
    AhHeadlineStylesCreate  ' create styles and
    Unload Me               ' cancel dialog
End Sub
 

Changing Styles Selection

'
' CBox Styles Selection changed
'
Private Sub m_cboxStyles_Change()
    On Error GoTo ErrorLabel
    If (m_cboxStyles.ListIndex >= 0) Then
        m_strStyleDesc.Caption = ActiveDocument.Styles(m_cboxStyles.Text).Description
        m_btnOK.Enabled = True
    Else
        m_strStyleDesc.Caption = "No style selected."
        m_btnOK.Enabled = False
    End If
    Exit Sub
ErrorLabel:
    m_strStyleDesc.Caption = "Error. Selected style doesn't exist?"
    m_btnOK.Enabled = False
End Sub

Other Parameters

'
' m_tbox_nLines_Change
'
Private Sub m_tbox_nLines_Change()
    EnableControls
End Sub
'
' m_tBox_Width_Change
'
Private Sub m_tBox_Width_Change()
   
EnableControls
End Sub

 

Module zAhHeadlineStyles

The zAhHeadlineStyles module contains the following functions for work with styles:

Public Function AhStyleExists(ByVal strStyleName As String) As Boolean
Sub AhCreateHeadlineStyles()

The functions of this module are “similar” to those, considered in Etude 4 “Styles”. So their source codes are not given here.

Module AhTextHeadline

The following basic and auxiliary functions are implemented in the “AhTextHeadline” module.

  • return to the normal mode
  • creation of the fictitious headline
  • formatting of the selected text
  • creation and deletion of Borders
  • creation and deletion of auxiliary Bookmarks
  • creation of styles
  • transfer to the headline formatting mode
  • auxiliary functions

 

Declarations

'
' File AhTextHeadline.dot|AhTextHeadline
'
' Etudes for Microsoft Word Programmers.
' Etude 1.7. Headline Fit.
'
' First published on http://www.transcriber.ru
'
' © 2000-2007. Evgeny Akhundzhanov. All rights reserved.
'
Option Explicit

Private bIsInHeadlineMode As Boolean
Private dwOldView As Long
Private dwOldColorIndex As Long
Private dwOldPageFit As Long
Private dwOldWindowState As Long
Private dwOldPercentage As Long
Private bRestoreColorIndex As Boolean

Constants

'
' Constants
'
Private Const cStrThisTemplateName As String = "AhTextHeadline.dot"
Private Const cStrThisTBName As String = "AhTextHeadline"
Private Const cStrHeadlineButtonName As String = "Headline"
Private Const cStrBookMark1 As String = "AhBookmark1"
Private Const cStrBookMark2 As String = "AhBookmark2"
Private Const chAsciiLF As Long = 10
Private Const chAsciiSR As Long = 11
Private Const chAsciiCR As Long = 13
Private Const cbSwitchToBestFit As Boolean = True
Private Const dwColorNormal As Long = wdBlue
Private Const dwColorExtra As Long = wdRed

Parameters

'
' Parameters for Settings dialog (AhTextHeadlineSettingsDialog)
'
Public g_dwSelectedStyleIndex As Long
Public g_strSelectedStyle As String
Public g_dwWidthInPoints As Long
Public g_dwNumberOfLines As Long

'
' Parameters
'
' Private Const cStrHeadlineStyle As String = "Headline2"      ' style to use
' Private Const cdwHeadlineWidth As Long = 400      ' width in points
' Private Const cdwHeadLinesCnt As Long = 2  ' number of lines for head line
Private Const cStrFillChar As String = "A"
'
' Settings
'
Private Const bInUseOnly As Boolean = False
Private Const bHeadlineStylesOnly As Boolean = True

Procedure AhTextHeadlineHelp

'
' AhTextHeadlineHelp
'
Sub AhTextHeadlineHelp()
MsgBox _
    "Etudes for Microsoft Word Programmers." & vbCrLf & _
    "Etude 7. Headline Fit." & vbCrLf & _
    "http://www.transcriber.ru" & vbCrLf & vbCrLf & _
    "Template AhTextHeadline.dot - Headline Fit" & vbCrLf & vbCrLf & _
    "Parameters are as follows:" & vbCrLf & _
    "Fill Character (hardcoded) = " & cStrFillChar & vbCrLf & vbCrLf & _
    "Other settings are selected from the dialog." & vbCrLf & _
    "" & vbCrLf
End Sub

Procedure AhTextHeadline

'
' AhTextHeadline
'
Sub AhTextHeadline()
    AhHeadline
End Sub

Procedure AhTurnHeadlineModeOff

'
' AhTurnHeadlineModeOff
' Call this from extern modules. For example, OnSave and OnClose events.
'
Sub AhTurnHeadlineModeOff()
    If bIsInHeadlineMode Then
        AhHeadline
    Else
        ' do nothing
    End If
    SaveItSelf
End Sub

Procedure SaveItSelf

'
' SaveItSelf - makes template with name cStrThisTemplateName "Saved".
'
Private Sub SaveItSelf()
    Dim tt As Template
    '
    ' find template with predefined name
    '
    For Each tt In Templates
        '
        ' Use case-insensitive compare for file names.
        '
        If LCase(tt.Name) = LCase(cStrThisTemplateName) Then
            tt.Saved = True
        End If
    Next tt
    ' Ah! 01-Oct-2007. ### Attached template. ###
End Sub

Function DoSelectStyleDialog

'
' DoSelectStyleDialog
'
Private Function DoSelectStyleDialog(ByRef strSelStyleName As String) As Boolean
    DoSelectStyleDialog = False
    Dim dlg As AhTextHeadlineSettingsDialog
    Set dlg = New AhTextHeadlineSettingsDialog
    With dlg
        '
        ' loop through document styles (cbHeadlineStylesONLY)
        '
        .InitDialogData bInUseOnly, bHeadlineStylesOnly
       
        ' testing error case
        '.m_cboxStyles.AddItem "HL Style 1 (doesn't exist)"
       
        .EnableControls
        .Show vbModal
        If dlg.dwDialogResult = vbOK Then
            DoSelectStyleDialog = True
            strSelStyleName = g_strSelectedStyle
            'MsgBox "index = " & .dwListIndex & vbCrLf & _
            '"g_index = " & g_dwSelectedStyleIndex & " g_Style = " & g_strSelectedStyle
        End If
    End With
    Set dlg = Nothing
End Function

Procedure AhHeadlineStylesCreate

'
' AhHeadlineStylesCreate
'
Public Sub AhHeadlineStylesCreate()
    If Documents.Count <= 0 Then Exit Sub
    AhCreateHeadlineStyles
End Sub

Procedure AhHeadline

'
' AhHeadline
'
Private Sub AhHeadline()
If Documents.Count <= 0 Then Exit Sub
Dim bHeadlineResult As Boolean

SaveItSelf

bHeadlineResult = True
   
If bIsInHeadlineMode Then
    '
    ' exit Headline mode
    '
    AhHeadlineRemove
    AhSetButtonState msoButtonUp
Else
    Dim strSelStyleName As String
    If Not DoSelectStyleDialog(strSelStyleName) Then
        Exit Sub
    End If
    '
    ' enter Headline mode
    '
    AhSetButtonState msoButtonDown
       
    Application.ScreenUpdating = False
   
    Dim dwHeadlineWidth As Long
    Dim dwHeadLinesCnt As Long
    '
    ' hardcoded Settings
    '
    ' dwHeadlineWidth = cdwHeadlineWidth
    ' dwHeadLinesCnt = cdwHeadLinesCnt
    '
    ' Settings from the dialog
    '
    dwHeadlineWidth = g_dwWidthInPoints     ' from Settings dialog
    dwHeadLinesCnt = g_dwNumberOfLines
   
    '
    ' Ah! 25-Jan-2006. Test data for full page width.
    '
    'With ActiveDocument.PageSetup
    '    dwHeadlineWidth = .PageWidth - .RightMargin - .LeftMargin
    'End With
   
    bHeadlineResult = AhHeadlineNew(dwHeadlineWidth, dwHeadLinesCnt, strSelStyleName, cStrFillChar)
    If Not bHeadlineResult Then
        AhSetButtonState msoButtonUp
    End If
    Application.ScreenUpdating = True
End If
'
' switch Headline mode
'
If bHeadlineResult Then
    bIsInHeadlineMode = Not bIsInHeadlineMode
    ' Debug.Print "bIsInHeadlineMode = ", bIsInHeadlineMode
End If
   
SaveItSelf
End Sub

Procedure AhSetButtonState

'
' AhSetButtonState
'
Private Sub AhSetButtonState(ByVal msoButtonState As Long)
     CommandBars(cStrThisTBName).Controls(cStrHeadlineButtonName).State = msoButtonState
End Sub

Procedure AhSwitchToPageView


'
' AhSwitchToPageView
'
Private Sub AhSwitchToPageView(ByVal bSwitchToPageView As Boolean)
If bSwitchToPageView Then
    dwOldView = ActiveWindow.View.Type
    ActiveWindow.View.Type = wdPageView
Else
    ActiveWindow.View.Type = dwOldView
End If
End Sub

Function AhHeadlineNew

'
' AhHeadlineNew
'
Private Function AhHeadlineNew(ByVal dwPoints As Long, ByVal dwHeaderNumLines As Long, ByVal strHeaderStyle As String, ByVal strDummy As String) As Boolean
Dim fParagraphSize As Single

    On Error GoTo ErrorLabel
    AhRemoveBookMarks
    fParagraphSize = ActiveDocument.PageSetup.PageWidth - _
        ActiveDocument.PageSetup.RightMargin - _
        ActiveDocument.PageSetup.LeftMargin - dwPoints
   
    If fParagraphSize < 0 Then
        MsgBox "Invalid Paragraph Size", vbOKOnly + vbExclamation
        AhHeadlineNew = False
        Exit Function
    End If
   
    AhSwitchToPageView True
   
    If (Selection.End - Selection.Start) <> 0 Then
        AhHeadlineSel fParagraphSize, strHeaderStyle, dwHeaderNumLines
    Else
        AhHeadlineNoSel fParagraphSize, strHeaderStyle, dwHeaderNumLines, strDummy
    End If
   
    AhBookMarkCreate cStrBookMark1
    AhBorderCreate
   
    If cbSwitchToBestFit Then
        AhSwitchToBestFit True
    End If
    AhHeadlineNew = True
    Exit Function
ErrorLabel:
    MsgBox "Error in AhHeadlineNew"
    AhHeadlineNew = False
End Function

Procedure AhSwitchToBestFit

'
' AhSwitchToBestFit
'
Private Sub AhSwitchToBestFit(ByVal bSwitchToBestFit As Boolean)
With ActiveWindow
    If bSwitchToBestFit Then
        dwOldPageFit = .ActivePane.View.Zoom.PageFit
        dwOldWindowState = .WindowState
        dwOldPercentage = .ActivePane.View.Zoom.Percentage
   
        .ActivePane.View.Zoom.PageFit = wdPageFitBestFit
        .WindowState = wdWindowStateMaximize
    Else
        .ActivePane.View.Zoom.PageFit = dwOldPageFit
        .ActivePane.View.Zoom.Percentage = dwOldPercentage
        .WindowState = dwOldWindowState
    End If
End With
End Sub

Procedure AhHeadlineSel

'
' AhHeadlineSel
'
Private Sub AhHeadlineSel(ByVal fParagraphSize As Single, ByVal strHeaderStyle As String, ByVal dwHeaderNumLines As Long)
Dim dwSelBeg As Long
Dim dwSelEnd As Long
Dim dwHeadlineEnd As Long
Dim dwChar As Long

With Selection

    dwSelBeg = .Start
    dwSelEnd = .End
    
    If (dwSelBeg <> 0) Then
        .Start = .Start - 1
        .End = .Start + 1
        dwChar = Asc(.Characters.Last)
        If (dwChar <> chAsciiCR) And (dwChar <> chAsciiLF) Then
            .InsertParagraphAfter
            dwSelBeg = dwSelBeg + 1
            dwSelEnd = dwSelEnd + 1
        End If
    End If
   
    .Start = dwSelBeg
    .End = dwSelEnd
    dwChar = Asc(.Characters.Last)
    If (dwChar <> chAsciiCR) And (dwChar <> chAsciiLF) Then
        .InsertParagraphAfter
        dwSelEnd = dwSelEnd + 1
    End If
   
    With .ParagraphFormat
        .style = strHeaderStyle
        dwOldColorIndex = .style.Font.ColorIndex
        .LeftIndent = 0
        .RightIndent = fParagraphSize
    End With
   
    .Start = dwSelBeg
    .End = dwSelBeg
    Dim i As Long
    For i = 1 To dwHeaderNumLines
        .MoveEnd wdLine
       
        '
        ' Ah! 25-Jan-2006. Insert SoftReturn when (width!=PageWidth).
        '
        If (i <> dwHeaderNumLines) Then
            dwChar = Asc(.Characters(.End - .Start))
            If (dwChar <> chAsciiCR) _
            And (dwChar <> chAsciiLF) _
            And (dwChar <> chAsciiSR) Then
                Selection.InsertAfter Text:=Chr(11) ' Soft return.
                dwSelEnd = dwSelEnd + 1
            End If
        End If
       
        If .End >= dwSelEnd Then
            .End = dwSelEnd
            Exit For
        End If
    Next
   
    dwChar = Asc(.Characters.Last)
    If (dwChar <> chAsciiCR) And (dwChar <> chAsciiLF) Then
        .InsertParagraphAfter
        dwSelEnd = dwSelEnd + 1
    End If
    dwHeadlineEnd = .End
   
    If (dwSelEnd - dwHeadlineEnd) > 0 Then
        .Start = dwHeadlineEnd
        .End = dwSelEnd
        AhBookMarkCreate cStrBookMark2
        .Font.ColorIndex = dwColorExtra
    End If
   
    .Start = dwSelBeg
    .End = dwHeadlineEnd
End With
End Sub

Procedure AhHeadlineNoSel

'
' AhHeadlineNoSel
'
Private Sub AhHeadlineNoSel(ByVal fParagraphSize As Single, ByVal strHeaderStyle As String, ByVal dwHeaderNumLines As Long, ByVal strDummy As String)
Dim dwCurLast As Long
Dim dwStart As Long
Dim dwChar As Long
    dwOldColorIndex = -1
   
    With Selection
        dwStart = .Start
        If .Start <> 0 Then
            dwChar = Asc(ActiveDocument.Characters(.Start))
            If (dwChar <> chAsciiCR) And (dwChar <> chAsciiLF) Then
                .MoveStart wdLine
            End If
            dwStart = .Start
            .Start = .Start - 1
            .End = .Start + 1
            dwChar = Asc(.Characters.Last)
            If (dwChar <> chAsciiCR) _
            And (dwChar <> chAsciiLF) _
            And (.Start <> 0) Then
                .InsertParagraphAfter
                dwStart = dwStart + 1
            End If
            .Start = dwStart
        End If
   
        Options.ReplaceSelection = True
   
        .InsertParagraphAfter
       
        '
        ' Ah! 30-Jan-2006. Without .Copy & .Paste - clipboard is not corrupted.
        '
        Dim nLine As Long
        For nLine = 1 To dwHeaderNumLines
            .TypeText UCase(strDummy)
            .Start = dwStart
            .End = dwStart + 2
       
            With .ParagraphFormat
                .style = strHeaderStyle
                .LeftIndent = 0
                .RightIndent = fParagraphSize
                .FirstLineIndent = 0
            End With

            Options.ReplaceSelection = False
       
            dwCurLast = .Start + 1
            Do
                .Start = dwCurLast
                .TypeText strDummy
                dwCurLast = .End
           
                .Start = dwStart
                .End = dwStart
                dwStart = .Start
           
                .MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
                If dwCurLast >= .End Then
                    .Start = dwCurLast - 1
                    .End = dwCurLast
                    .Delete
                    Exit Do
                End If
            Loop
            If nLine <> dwHeaderNumLines Then
                .TypeText Chr(11)
            End If
        dwStart = .Start
        .MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
        .End = .End - 1
       
        '.Copy   ' this corrupts clipboard
        'Dim i As Long
        'For i = 2 To dwHeaderNumLines
        '    .Paste
        'Next
        Next nLine
       
        .End = .Start
        .MoveDown Unit:=wdLine
        dwCurLast = .Start - 1
        .Start = dwStart
        .End = dwCurLast
    End With
      
    Options.ReplaceSelection = True
End Sub

Procedure AhSetBorderParams

'
' AhSetBorderParams
'
Private Sub AhSetBorderParams(ByVal wdBorderType As Long, ByVal wdLineStyle As Long, ByVal wdLineWidth As Long, ByVal dwColorIndex As Long)
    On Error Resume Next
    With Selection.ParagraphFormat.Borders(wdBorderType)
        .LineStyle = wdLineStyle
        .LineWidth = wdLineWidth
        .ColorIndex = dwColorIndex
    End With
End Sub

Procedure AhSetBorderHide

'
' AhSetBorderHide
'
Private Sub AhSetBorderHide(ByVal wdBorderType As Long)
    On Error Resume Next
    With Selection.ParagraphFormat.Borders(wdBorderType)
        .LineStyle = wdLineStyleNone
    End With
End Sub

Procedure AhSetBorderDistances

'
' AhSetBorderDistances
'
Private Sub AhSetBorderDistances()
    On Error Resume Next
    With Selection.ParagraphFormat.Borders
        .DistanceFromTop = 1
        .DistanceFromLeft = 4
        .DistanceFromBottom = 1
        .DistanceFromRight = 4
        .Shadow = False
    End With
End Sub

Procedure AhSetDefaultBorderOptions

'
' AhSetDefaultBorderOptions
'
Private Sub AhSetDefaultBorderOptions()
    On Error Resume Next
    With Options
        .DefaultBorderLineStyle = wdLineStyleSingle
        .DefaultBorderLineWidth = wdLineWidth050pt
        .DefaultBorderColorIndex = dwColorNormal
    End With
End Sub

Procedure AhBorderCreate

'
' AhBorderCreate
'
Private Sub AhBorderCreate()
    AhSetBorderParams wdBorderLeft, wdLineStyleSingle, wdLineWidth050pt, dwColorNormal
    AhSetBorderParams wdBorderRight, wdLineStyleSingle, wdLineWidth050pt, dwColorNormal
       
    AhSetBorderHide wdBorderTop
    AhSetBorderHide wdBorderBottom
   
    AhSetBorderDistances
    AhSetDefaultBorderOptions
End Sub

Procedure AhBorderRemove

'
' AhBorderRemove
'
Private Sub AhBorderRemove()
    AhSetBorderHide wdBorderLeft
    AhSetBorderHide wdBorderRight
   
    AhSetBorderHide wdBorderTop
    AhSetBorderHide wdBorderBottom
   
    AhSetBorderDistances
    AhSetDefaultBorderOptions
End Sub

Procedure AhBookMarkCreate

'
' AhBookMarkCreate
'
Private Sub AhBookMarkCreate(ByVal strBookMarkName As String)
    With ActiveDocument.Bookmarks
        .Add range:=Selection.range, Name:=strBookMarkName
        .DefaultSorting = wdSortByName
        .ShowHidden = True
    End With
End Sub

Procedure AhBookMarkRemove

'
' AhBookMarkRemove
'
Private Sub AhBookMarkRemove(ByVal strBookMarkName As String)
    On Error Resume Next
    ActiveDocument.Bookmarks(strBookMarkName).Delete
End Sub

Procedure AhBookMarksDump

'
' AhBookMarksDump
'
Sub AhBookMarksDump()
Dim bm As Bookmark
    Debug.Print "AhBookMarksDump +++"
    For Each bm In ActiveDocument.Bookmarks
        Debug.Print bm.Name, bm.range.Start, bm.range.End
    Next bm
    Debug.Print "AhBookMarksDump ==="
    '
    ' Builtin bookmarks are not listed in previous loop.
    '
    Set bm = ActiveDocument.Bookmarks("\Para")
    Debug.Print bm.Name, bm.range.Start, bm.range.End
End Sub

Procedure AhRemoveBookMarks

'
' AhRemoveBookMarks
'
Private Sub AhRemoveBookMarks()
    AhBookMarkRemove cStrBookMark2
    AhBookMarkRemove cStrBookMark1
End Sub
 

Procedure AhGoToBookMark

'
' AhGoToBookMark
'
Private Sub AhGoToBookMark(ByVal strBookMarkName As String)
    On Error GoTo Error
    With Selection
        .GoTo What:=wdGoToBookmark, Name:=strBookMarkName
    End With
Error:
End Sub

Procedure AhHeadlineRemove

'
' AhHeadlineRemove
'
Private Sub AhHeadlineRemove()
    AhGoToBookMark cStrBookMark1
    Selection.ParagraphFormat.RightIndent = 0
   
    AhBorderRemove
   
    AhGoToBookMark cStrBookMark2
    Selection.ParagraphFormat.RightIndent = 0
   
    If (-1 <> dwOldColorIndex) Then
        Selection.Font.ColorIndex = dwOldColorIndex
    End If
    AhRemoveBookMarks
   
    Selection.End = Selection.Start
   
    If cbSwitchToBestFit Then
        AhSwitchToBestFit False
    End If
    AhSwitchToPageView False
End Sub

Conclusions

The "AhTextHeadline.dot" template is created on the basis of functional specification. It contains macros for headline formatting and the dialog for keying in/entering settings.

The following functions are implemented in the “AhTextHeadline.dot” template.

  • creation and deletion of Borders
  • creation and deletion of auxiliary Bookmarks
  • creation of styles
  • transfer to the headline formatting mode
  • return to the normal mode
  • creation of the fictitious headline
  • formatting of the selected text
  • dialog for editing settings
  • auxiliary functions

The “AhTextHeadline” toolbar provides simple interface to the headline formatting operation.

 

Task 1

The selected style in the dialog and all other settings as well are not saved till the next call. Save parameters and make this set of macros convinient to use.

 

 


Etudes for Microsoft Word Programmers.
Etude 1.7. Formatting Headline.


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