次のページの最初の2つの単語をフッターに配置する（Microsoft Word）

Sub FillFooter()

Dim iPage As Integer     Dim iSec As Integer     Dim sFText As String     Dim sTemp As String

sFText = "See next page for this: "



Selection.HomeKey Unit:=wdStory     ' Go to beginning of document

' Use Find and Replace to get rid of all section breaks     Selection.Find.ClearFormatting     Selection.Find.Replacement.ClearFormatting     With Selection.Find         .Text = "^b"

.Replacement.Text = ""

.Forward = True         .Wrap = wdFindContinue         .Format = False         .MatchCase = False         .MatchWholeWord = False         .MatchByte = False         .MatchAllWordForms = False         .MatchSoundsLike = False         .MatchWildcards = False         .MatchFuzzy = False     End With     Selection.Find.Execute Replace:=wdReplaceAll

iSec = 1            ' Only 1 section now in document     For iPage = 1 To Selection.Information(wdNumberOfPagesInDocument) - 1         ' Figure out first two words on "next page"

Selection.GoTo what:=wdGoToPage, which:=wdGoToNext, Name:=iPage + 1         Selection.MoveRight Unit:=wdWord, Count:=2, Extend:=wdExtend         sTemp = Trim(Selection)

While Asc(Right(sTemp, 1)) < 65             ' Word counts punctuation, tabs, etc. as a word, so grab another word             Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend             sTemp = Trim(Selection)

Wend                  Selection.Collapse      ' Now at beginning of page again         Selection.MoveUp Unit:=wdParagraph         Selection.InsertBreak Type:=wdSectionBreakContinuous                  ' Set text for page footer         With ActiveDocument.Sections(iSec).Footers(wdHeaderFooterPrimary)

.LinkToPrevious = False             .Range.Text = sFText & sTemp         End With         iSec = iSec + 1     Next iPage End Sub