Insert footer in last page using VBA

[cc900630]

How can I put text into the footer of the final page using VBA ?

I can do it manually using:
{ IF { PAGE } = NUMPAGES "Text here" } }

But I need to do it with a macro

Thanks
hals_left

 

[Greg]

Something like this:
Sub InsertNestedPageFieldInFooter()
Dim myRng As Range
Dim oDoc As Document

Set oDoc = ActiveDocument
Application.ScreenUpdating = False
ActiveWindow.View.ShowFieldCodes = True
'Insert dummy para at end of document
ActiveDocument.Range.InsertAfter vbCr
Set myRng = oDoc.Range
With myRng
.Collapse wdCollapseEnd
.Select
End With
With Selection
.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"PAGE", PreserveFormatting:=False
.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdCollapseStart
.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
.TypeText Text:="IF "
.MoveRight Unit:=wdCharacter, Count:=8, Extend:=wdCollapseEnd
.TypeText Text:=" = "
.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"NUMPAGES", PreserveFormatting:=False
.MoveRight Unit:=wdCharacter, Count:=1
.TypeText Text:="""Your footer text"""
.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
End With
oDoc.Fields.Update
ActiveWindow.View.ShowFieldCodes = False
Set myRng = oDoc.Paragraphs.Last.Range
myRng.Cut
Set myRng = oDoc.Sections(1).Footers(wdHeaderFooterPrimary).Range
myRng.Collapse wdCollapseEnd
myRng.Paste
Application.ScreenUpdating = True
End Sub

 

[Greg]

This version might be slightly more straight forward:

Sub InsertNestedFields()
Dim myRng As Range
Dim oDoc As Document
Set oDoc = ActiveDocument
Application.ScreenUpdating = False
ActiveWindow.View.ShowFieldCodes = True
'Build the field code
ActiveDocument.Range.InsertAfter vbCr
Set myRng = oDoc.Range
With myRng
.Collapse wdCollapseEnd
.Select
End With
With Selection
.Fields.Add Selection.Range, wdFieldIf, , PreserveFormatting:=False
.MoveRight wdCharacter, 5, wdCollapseEnd
.Fields.Add Selection.Range, wdFieldPage, , PreserveFormatting:=False
.TypeText Text:=" = "
.Fields.Add Selection.Range, wdFieldNumPages, ,
PreserveFormatting:=False
.TypeText Text:="""Your footer text"""
End With
oDoc.Fields.Update
ActiveWindow.View.ShowFieldCodes = False
'Cut field results to clipboard
Set myRng = oDoc.Paragraphs.Last.Range
myRng.Cut
'Paster field results in footer
Set myRng = oDoc.Sections(1).Footers(wdHeaderFooterPrimary).Range
myRng.Collapse wdCollapseEnd
myRng.Paste
Application.ScreenUpdating = True
End Sub

 

[Dave Lett]

Hi all,

Very interesting task. I like the code you posted and it's easily adaptable
to place the nested fields in the last section. But we don't know the end
user's Page setup (different first page, different odd/even pages). I
developed the following routine to incorporate the fields even if those
options haven't been selected. That is, you can run this routine and then
enable these options later, and the text will still appear.

Public Sub ModifyFooterOnLastPage()
Dim oSec As Section
With ActiveDocument
Set oSec = .Sections(.Sections.Count)
End With
With oSec
Set oRng = .Footers(wdHeaderFooterPrimary).Range
Call fInsertText(oRng:=oRng)

Set oRng = .Footers(wdHeaderFooterEvenPages).Range
Call fInsertText(oRng:=oRng)

Set oRng = .Footers(wdHeaderFooterFirstPage).Range
Call fInsertText(oRng:=oRng)
End With
End Sub

Public Sub fInsertText(oRng As Range)
Dim oRng1 As Range
Dim oRng2 As Range
Dim oRng3 As Range
With oRng
.Collapse Direction:=wdCollapseEnd
.Text = "IF PAGE = NUMPAGES ""Text here"""
Set oRng1 = .Duplicate
Set oRng2 = .Duplicate
Set oRng3 = .Duplicate
End With
Call fInsertFields(oRange:=oRng1, sText:="PAGE", bWild:=False)
Call fInsertFields(oRange:=oRng2, sText:="NUMPAGES", bWild:=False)
Call fInsertFields(oRange:=oRng3, sText:="IF*here""", bWild:=False)
End Sub

Public Sub fInsertFields(oRange As Range, sText As String, bWild As Boolean)
With oRange
Set oRng = .Duplicate
oRng.Find.Execute FindText:=sText, MatchCase:=True, MatchWildcards:=bWild
oRng.Fields.Add Range:=oRng, Type:=wdFieldEmpty, _
PreserveFormatting:=False
.Fields.Update
End With
End Sub

HTH,
Dave

 

[Greg]

Dave,

Fine work IMHO! While it works, I haven't figured out how the
following is working:

Call fInsertFields(oRange:=oRng3, sText:="IF*here""", bWild:=False)

You are passing a wildcard string but setting the matchwildcard option
to false.

Actually the code is working regardless if this is set to false or
true. Haven't figured out why it is working when set to false. Ideas?

 

[cc900630]

Thanks but I get a compile erroe - byref argument type mismatch on the
follwing line (the first occurance)
Call fInsertText(oRng:=oRng)

When stepping into the code starting at ModifyFooterOnLastPage()

 

[Dave Lett]

Hi Greg,

Nice catch. Having it set to False is a typo. I should have set it to True.
More importantly, no, I do NOT know why it works regardless of the setting.

 

[Jean-Guy Marcil]

(e-mail address removed) was telling us:
(e-mail address removed) nous racontait que :

Thanks but I get a compile erroe - byref argument type mismatch on the
follwing line (the first occurance)
Call fInsertText(oRng:=oRng)

When stepping into the code starting at ModifyFooterOnLastPage()

Add
Dim oRng As Range
right under
Dim oSec As Section
in the
Public Sub ModifyFooterOnLastPage()
sub.


Without that line, I believe that oRng is effectively a Variant type
containing a range object.
The called sub is expecting a Range type.


--
Salut!
_______________________________________
Jean-Guy Marcil - Word MVP
(e-mail address removed)
Word MVP site: http://www.word.mvps.org

 

[cc900630]

Thanks
I already tried
Dim oRng
but that diddnt help, I will try adding the type on Monday!

 

[Dave Lett]

Hi Greg,
Indeed, I think I figured it out. It worked because of dumb luck. I did some
testing and realized that the dumb luck occurs in the fInsertFields routine.
It doesn't matter if the calling routine fails/succeeds in finding the text
because the range does NOT change. Therefore, you could do a search for ANY
text whatsoever, and the routine would still succeed. That is, regardless of
success or failure in finding the text, the Range (oRange) and its duplicate
are the same, and that range is the same as the text inserted in the
fInsertText routine. Try it with any text, and you'll see: Dumb Luck.
Call fInsertFields(oRange:=oRng3, sText:="Any text under the sun????!!!!""",
bWild:=False)

HTH,
Dave

 

[Greg]

Dave,

Yep. That is right. So it seems we should change the code to:

Public Sub fInsertText(oRng As Range)
.....
Call fInsertFields(oRange:=oRng1, sText:="PAGE")
Call fInsertFields(oRange:=oRng2, sText:="NUMPAGES")
Call fInsertFields(oRange:=oRng3)
End Sub

Public Sub fInsertFields(oRange As Range, Optional sText As String)
With oRange
Set oRng = .Duplicate
oRng.Find.Execute FindText:=sText, MatchCase:=True
oRng.Fields.Add Range:=oRng, Type:=wdFieldEmpty, _
PreserveFormatting:=False
.Fields.Update
End With
End Sub

 

[Cindy M -WordMVP-]

Hi =?Utf-8?B?RGF2ZSBMZXR0?=,

In order to have two independent ranges when using Find (so that you can return
to the original):
Set rng2 = rng1.Duplicate

Indeed, I think I figured it out. It worked because of dumb luck. I did some
testing and realized that the dumb luck occurs in the fInsertFields routine.
It doesn't matter if the calling routine fails/succeeds in finding the text
because the range does NOT change. Therefore, you could do a search for ANY
text whatsoever, and the routine would still succeed. That is, regardless of
success or failure in finding the text, the Range (oRange) and its duplicate
are the same, and that range is the same as the text inserted in the
fInsertText routine. Try it with any text, and you'll see: Dumb Luck.
Call fInsertFields(oRange:=oRng3, sText:="Any text under the sun????!!!!""",
bWild:=False)

Cindy Meister
INTER-Solutions, Switzerland
http://homepage.swissonline.ch/cindymeister (last update Jun 8 2004)
http://www.word.mvps.org

This reply is posted in the Newsgroup; please post any follow question or reply
in the newsgroup and not by e-mail

 

[cc900630]

Thanks, works great now.