Macro to automate footer

[Guest]

I am well versed in Excel VBA but I'm finding Word more difficult.

I would like to write a macro to enter the date left aligned, page x of y
centered and the pathname rightaligned all in one row of the page footer.

In Excel it's understandable

ActiveSheet.PageSetup.LeftFooter = "&8&H&X&D &T"

ActiveSheet.PageSetup.RightHeader = "&8&H&XPage &P of &N"

Could someone kindly advise the code to use for word?

Thanks in advance for your assistance.

JH Palmer

 

[Suzanne S. Barnhill]

You don't use a macro in Word. You create the desired footer and save the
document as a template, then use that template when you want a document with
that footer. The Header and Footer style in Word have built-in tab stops at
the center and right margin to facilitate this sort of layout.

--
Suzanne S. Barnhill
Microsoft MVP (Word)
Words into Type
Fairhope, Alabama USA

Email cannot be acknowledged; please post all follow-ups to the newsgroup so
all may benefit.

 

[Greg]

JH,

This might get you started. Hacked together from code
Doug Robbins posted for FLUSH right. It only affects the
primary footer, so if you run the code and then change
Page Layout Header and Footer sections you will need to
copy the text to the ODD, Even, or First Page footer. I
suppose you could make that automatic with a little more
code:

Sub SetupFooter()
On Error GoTo ErrorHandling
Dim sngLeftMargin As Single
Dim sngRightMargin As Single
Dim sngPageWidth As Single
Dim sngWidthToRight As Single
Dim sngHalfWayPoint As Single

'Retrieve margin, center and page width values
sngLeftMargin = CSng(ActiveDocument.PageSetup.LeftMargin)
sngRightMargin = CSng(ActiveDocument.PageSetup.RightMargin)
sngPageWidth = CSng(ActiveDocument.PageSetup.PageWidth)
sngWidthToRight = sngPageWidth - (sngLeftMargin +
sngRightMargin)
sngHalfWayPoint = sngWidthToRight / 2
Application.ScreenUpdating = False

'Go to footer

If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or
ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView =
wdSeekCurrentPageHeader
If Selection.HeaderFooter.IsHeader = True Then
ActiveWindow.ActivePane.View.SeekView =
wdSeekCurrentPageFooter
Else
ActiveWindow.ActivePane.View.SeekView =
wdSeekCurrentPageHeader
End If

'Position Tabs Stops

With Selection.Paragraphs.TabStops
.ClearAll
.Add Position:=sngHalfWayPoint,
Alignment:=wdAlignTabCenter, Leader:=wdTabLeaderSpaces
.Add Position:=sngWidthToRight,
Alignment:=wdAlignTabRight, Leader:=wdTabLeaderSpaces
End With
Selection.Fields.Add Range:=Selection.Range,
Type:=wdFieldEmpty, _
PreserveFormatting:=False
Selection.TypeText Text:="CREATEDATE"
Selection.MoveRight Unit:=wdCharacter, Count:=3,
Extend:=wdMove
Selection.TypeText Text:=vbTab
Selection.Fields.Add Range:=Selection.Range,
Type:=wdFieldEmpty, _
PreserveFormatting:=False
Selection.TypeText Text:="PAGE"
Selection.MoveRight Unit:=wdCharacter, Count:=3,
Extend:=wdMove
Selection.TypeText Text:=" of "
Selection.Fields.Add Range:=Selection.Range,
Type:=wdFieldEmpty, _
PreserveFormatting:=False
Selection.TypeText Text:="NUMPAGES"
Selection.MoveRight Unit:=wdCharacter, Count:=3,
Extend:=wdMove
Selection.TypeText Text:=vbTab
Selection.Fields.Add Range:=Selection.Range,
Type:=wdFieldEmpty, _
PreserveFormatting:=False
Selection.TypeText Text:="FILENAME \p"
Selection.WholeStory
Application.Run
MacroName:="Normal.MyMacros.UpdateFields"
ActiveWindow.ActivePane.View.SeekView =
wdSeekMainDocument
Application.ScreenUpdating = True 'display on
ErrorHandling:
End Sub

 

[Guest]

Thanks Greg

Saying it's more complicated than Excel was an understatement.

Is this missing an "updateFields" macro?

I had to remove several carriage returns to get rid of compile errors but I
still couldn't get it to run.

 

[Greg Maxey]

JH,

Yes it is missing an an update fields. I has my Update Fields macro, but
then you don't do you
Sorry.
Try changing: Application.Run MacroName:="Normal.MyMacros.UpdateFields"
to ActiveDocument.Fields.Update

I cobbled this thing together during a slow moment at work. I just copied
here at home and seem to work just fine.

You know, I don't know what you are really trying to do, but it seem like
you could just create a template with this informtion and format your
documents that way.

 

[Guest]

Thanks very much Greg

That did the trick.

You're right, I should set up a template, and I will have to do that.

You're program is very useful for cases when someone else sends me a
document. Very often we have to update something and can't remember it is
saved under "H:\procedures\accounting\month end\..."

I think all documents should have the whole pathname in the footer.

One more thing. Could you tell me the code to make it a smaller font?

Have a good day.

Jim Palmer

 

[Greg Maxey]

JH

Try this:

Sub SetupFooter()
On Error GoTo ErrorHandling
Dim sngLeftMargin As Single
Dim sngRightMargin As Single
Dim sngPageWidth As Single
Dim sngWidthToRight As Single
Dim sngHalfWayPoint As Single

'Retrieve margin, center and page width values
sngLeftMargin = CSng(ActiveDocument.PageSetup.LeftMargin)
sngRightMargin = CSng(ActiveDocument.PageSetup.RightMargin)
sngPageWidth = CSng(ActiveDocument.PageSetup.PageWidth)
sngWidthToRight = sngPageWidth - (sngLeftMargin + sngRightMargin)
sngHalfWayPoint = sngWidthToRight / 2
Application.ScreenUpdating = False

'Go to footer

If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
If Selection.HeaderFooter.IsHeader = True Then
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Else
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
End If

'Position Tabs Stops

With Selection.Paragraphs.TabStops
.ClearAll
.Add Position:=sngHalfWayPoint, Alignment:=wdAlignTabCenter,
Leader:=wdTabLeaderSpaces
.Add Position:=sngWidthToRight, Alignment:=wdAlignTabRight,
Leader:=wdTabLeaderSpaces
End With
With Selection
.Font.Size = 6

.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
.TypeText Text:="CREATEDATE"
.MoveRight Unit:=wdCharacter, Count:=3, Extend:=wdMove
.TypeText Text:=vbTab
.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
.TypeText Text:="PAGE"
.MoveRight Unit:=wdCharacter, Count:=3, Extend:=wdMove
.TypeText Text:=" of "
.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
.TypeText Text:="NUMPAGES"
.MoveRight Unit:=wdCharacter, Count:=3, Extend:=wdMove
.TypeText Text:=vbTab
.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
.TypeText Text:="FILENAME \p"
.WholeStory

End With
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
ActiveDocument.PrintPreview
ActiveDocument.ClosePrintPreview
Application.ScreenUpdating = True 'display on

ErrorHandling:
End Sub

 

[AfricanHealer]

Actually you can do this... You may write this out in VBA but I jus
recorded it to edit the footer and then select "insert auto text",
selected file name and path; then selected all and changed the font an
size and added my page number and date information. Then I exited th
footer and stopped recording. That way I got what I wanted but didn'
have to write the original code. Then I can edit at will.

Its much better to have a macro to run on existing files or when yo
want rather than a template. Template's are only good when you ar
creating from scratch - and frankly not so good then.

OK - good luck
AfricanHealer

*I am well versed in Excel VBA but I'm finding Word more difficult.

I would like to write a macro to enter the date left aligned, page
of y
centered and the pathname rightaligned all in one row of the pag
footer.

In Excel it's understandable

ActiveSheet.PageSetup.LeftFooter = "&8&H&X&D &T"

ActiveSheet.PageSetup.RightHeader = "&8&H&XPage &P of &N"

Could someone kindly advise the code to use for word?

Thanks in advance for your assistance.

JH Palmer

-
AfricanHeale