Catchwords in Footer

There is no charge for using any of the material (for personal use) on this web site, but if you wish to make a contribution to the ever growing running costs, any donation would be much appreciated. Click the adjacent button to access PayPal

Add the catchword(s) from the top of the following page to the footer
	A questioner in a Word forum wanted a means of adding catchwords - the first word (or words) from the top of the following page - to the footer of his document, as shown in the example below. Word has no integral method of doing this - the closest it can manage is the Styleref field, but that can only reproduce information from the current page. A different method had to be found. The solution I have produced requires that the first word(s) on each page after the first is(are) given a numbered bookmark in which the number relates to the page on which the footer will appear. i.e. the word(s) bookmarked on page 2 will be reproduced on page 1 and will have the corresponding number 1 in the bookmark name. For the sake of this exercise I chose to use the bookmark name Wordn where n is the number of the previous page. This information is then reproduced in the footer by means of a conditional field construction (second illustration).


	The following macro will bookmark the first word(s) on each page but the first of the finished document. The macro prompts for the number of words to be bookmarked (three in the above example) - the default is 1.
Note:	The macro should not be run until all other editing of the document is completed as further editing will probably change which words are first on the pages, however I have included a macro to remove the bookmarks if the document requires further editing. Edit the document re-add the bookmarks and update the footer fields.
The Macro Code
	Sub BookmarkCatchwords() 'Bookmarks the first word on each page Dim Count As Long Dim x As Long Dim bName As String Dim sNumber As String sNumber = InputBox("Bookmark how many words at the top of each page?", "Bookmark", 1) Selection.HomeKey Unit:=wdStory Count = ActiveDocument.BuiltInDocumentProperties("Number of Pages") For x = 1 To Count - 1 Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext Selection.MoveRight Unit:=wdWord, Count:=sNumber, Extend:=wdExtend bName = "Word" & x ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:=bName Next x End Sub
Remove the bookmarks inserted by the previous macro
	Sub BookmarkCatchwordsDelete() Dim Count As Long Count = ActiveDocument.BuiltInDocumentProperties("Number of Pages") For x = 1 To Count On Error Resume Next ActiveDocument.Bookmarks("Word" & x).Delete Next x End Sub
Insert the field codes
	You may find it simpler to manually insert the fields in the footer; however the following macro will insert the fields as shown in the second illustration. The fields are aligned right, but beyond that the formatting is that applied by the paragraph style into which the fields are inserted - by default the footer style.
	Sub AddCatchwordsToFooter() Dim sView As String 'record preferred view sView = ActiveWindow.ActivePane.View.Type 'Select PrintLayout view ActiveWindow.ActivePane.View.Type = wdPrintView 'Open footer ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter With Selection 'Align fields to right margin .ParagraphFormat.Alignment = wdAlignParagraphRight 'Insert the fields .Fields.Add Range:=.Range, Type:=wdFieldEmpty, _ PreserveFormatting:=False .TypeText Text:="IF" .Fields.Add Range:=.Range, Type:=wdFieldEmpty, _ PreserveFormatting:=False .TypeText Text:="Page" .MoveRight Unit:=wdCharacter, Count:=2 .TypeText Text:=" <> " .Fields.Add Range:=.Range, Type:=wdFieldEmpty, _ PreserveFormatting:=False .TypeText Text:="Numpages" .MoveRight Unit:=wdCharacter, Count:=2 .TypeText Text:=" """ .Fields.Add Range:=.Range, Type:=wdFieldEmpty, _ PreserveFormatting:=False .TypeText Text:="REF ""Word" .Fields.Add Range:=.Range, Type:=wdFieldEmpty, _ PreserveFormatting:=False .TypeText Text:="Page" .MoveRight Unit:=wdCharacter, Count:=2 .TypeText Text:="""" .MoveRight Unit:=wdCharacter, Count:=2 .TypeText Text:="""" .MoveRight Unit:=wdCharacter, Count:=2 'Add the four dots at the end of the field .TypeText Text:="...." End With 'Close the footer ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument 'Return to the stored preferred view ActiveWindow.ActivePane.View.Type = sView 'Update the fields ActiveDocument.PrintPreview ActiveDocument.ClosePrintPreview 'Ensure field results are displayed ActiveWindow.View.ShowFieldCodes = False End Sub
Note:	If you do not know how to employ this code, see the tutorial elsewhere on this site.