Many people access the material from this web site daily. Most just leech what they want and run. That's OK, provided they are not selling on the material as their own; however if your productivity gains from the material you have used, a donation from the money you have saved, however small, would help to ensure the continued availability of this resource.

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.

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

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
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