Solved

VBA macro for simple last page footer

Posted on 2006-11-03
13
3,633 Views
Last Modified: 2012-05-07
Hello,

Using Word 2003.  Need code for inserting the document filename and path (c:\docs\document1.doc) in a footer on only the last page of a document.  Left justified.  8-pt. Times New Roman.

Goal is to have a toolbar button for users.  This an urgent matter for me, and I know nothing about VBA.
 
Thank you!
0
Comment
Question by:DetersLaw
  • 5
  • 4
  • 3
  • +1
13 Comments
 
LVL 14

Expert Comment

by:Farzad Akbarnejad
ID: 17871572
Hi DetersLaw,

Here is the VBA code for your macro. You can add it to your template (probably Normal.dot) then create a toolbar button and keyboard shortcut and a button image for it.


'====================================================================

Sub HiddenSpace()
'
' HiddenSpace Macro
' Macro recorded 8/21/2006 by Farzad Akbarnejad
'
    Selection.TypeText Text:=ChrW(8204)
End Sub
Sub InsertFilespecLastPage()
'
' InsertFilespecLastPage Macro
' Macro recorded 11/4/2006 by FarzadA
'
    Selection.EndKey Unit:=wdStory
    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
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
        PreserveFormatting:=False
    Selection.TypeText Text:="IF "
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
        PreserveFormatting:=False
    Selection.TypeText Text:="PAGE"
    Selection.Fields.ToggleShowCodes
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.TypeText Text:="="
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
        PreserveFormatting:=False
    Selection.TypeText Text:="NUMPAGES"
    Selection.Fields.ToggleShowCodes
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.TypeText Text:=" "
    NormalTemplate.AutoTextEntries("Filename and path").Insert Where:= _
        Selection.Range, RichText:=True
    Selection.Fields.ToggleShowCodes
    With Selection.ParagraphFormat
        .LeftIndent = MillimetersToPoints(2.8)
        .RightIndent = MillimetersToPoints(0)
        .SpaceBefore = 0
        .SpaceBeforeAuto = False
        .SpaceAfter = 0
        .SpaceAfterAuto = False
        .LineSpacingRule = wdLineSpaceSingle
        .Alignment = wdAlignParagraphLeft
        .WidowControl = True
        .KeepWithNext = False
        .KeepTogether = False
        .PageBreakBefore = False
        .NoLineNumber = False
        .Hyphenation = True
        .FirstLineIndent = MillimetersToPoints(0)
        .OutlineLevel = wdOutlineLevelBodyText
        .CharacterUnitLeftIndent = 0
        .CharacterUnitRightIndent = 0
        .CharacterUnitFirstLineIndent = 0
        .LineUnitBefore = 0
        .LineUnitAfter = 0
        .ReadingOrder = wdReadingOrderLtr
    End With
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub

'==========================================================================

http://office.microsoft.com/assistance/hfws.aspx?AssetID=HP051867041033&CTT=1&Origin=EC010227171033
http://wordtips.vitalnews.com/Pages/T0670_Using_Last-page_Headers_and_Footers.html


-FA
0
 
LVL 14

Expert Comment

by:Farzad Akbarnejad
ID: 17871604
Sorry. You can remove HiddenSpace(). It was a macro in my template that paste here. Your macro is InsertFilespecLastPage().

-FA
0
 
LVL 14

Expert Comment

by:Farzad Akbarnejad
ID: 17871688
Something that I have come a cross:
If you run the macro on a unsaved document, you find the filename similar to Document1 on the footer. After saving the document you must update the field to get the full path of your file. The easier way is to run the macro on a beforee saved file.

-FA
0
Free Tool: Postgres Monitoring System

A PHP and Perl based system to collect and display usage statistics from PostgreSQL databases.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
LVL 76

Expert Comment

by:GrahamSkan
ID: 17872617
You need to use an IF field with other nested fields which tests the page number. It needs to be in the last section, and it's best to put it in any footer types (Primary, First page, Even page) that are in use.

The field code would look like this:
{ IF { PAGE } = { NUMPAGES } { FILENAME } \* MERGEFORMAT }

This method works directly on the Word components:

Sub LastPageField()
    Dim rng As Range
    Dim ftr As HeaderFooter
    Dim fld As Field
   
    For Each ftr In ActiveDocument.Sections.Last.Footers
        If ftr.Exists Then
            Set rng = ftr.Range
            rng.Collapse wdCollapseStart
            Set fld = ActiveDocument.Fields.Add(rng, wdFieldIf, , True)
            fld.ShowCodes = True
            rng.Move wdCharacter, 4
            ActiveDocument.Fields.Add rng, wdFieldPage, , False
            rng.Move wdCharacter, 9
            rng.InsertAfter "="
            rng.Move wdCharacter, 2
            ActiveDocument.Fields.Add rng, wdFieldNumPages, , False
            rng.Move wdCharacter, 12
            ActiveDocument.Fields.Add rng, wdFieldFileName, , False
            fld.Update
            fld.ShowCodes = False
        End If
    Next ftr
End Sub



0
 
LVL 21

Expert Comment

by:EricFletcher
ID: 17873108
Just to add to Graham's field code suggestion: if you want the path to show with the file name, include the "\p" switch. (i.e. { FILENAME \p } for the TrueText value of the IF field.)
0
 

Author Comment

by:DetersLaw
ID: 17873422
Anticipating user frustration, the macro should update the footer each time it is run, not insert additional text.  Users do lots of 'save as', and would be unhappy having to edit the footer each time to delete the outdated information and run the macro again for the new docpath/docname.  Apologies for the change in scope....  

FA,
Your attempt puts the footer on every page and is not 8pt.

GS,
Your attempt produces a footer on only the last page, but is also not 8pt font size.
The actual footer text looks like this: 'Error! Unknown op code for conditional.Doc1.doc'

Thanks for the great first attempts!
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 17873566
I forgot about the formatting. Also it needed to have the field codes displayed. Unfortunately, the document-wide setting for that display is a toggle. It can't be tested, so there is a risk of turning it off instead of on. I've had to show the codes for the fields individually.

I've put the \p in the FILENAME field that Eric suggested that you might need.

Sub LastPageField()
    Dim rng As Range
    Dim ftr As HeaderFooter
    Dim fld As Field
    Dim fld1 As Field
    Dim f As Integer
    For Each ftr In ActiveDocument.Sections.Last.Footers
       If ftr.Exists Then
            If ftr.Range.Fields.Count > 3 Then
                If ftr.Range.Fields(1).Type = wdFieldIf Then
                    Exit Sub
                End If
            End If
            Set rng = ftr.Range
            rng.Collapse wdCollapseStart
            rng.ParagraphFormat.Alignment = wdAlignParagraphLeft
            Set fld = ActiveDocument.Fields.Add(rng, wdFieldIf, "  \* CHARFORMAT", False)
            fld.ShowCodes = True
            rng.Expand wdCharacter
            rng.Font.Name = "Times New Roman"
            rng.Font.Size = 8
            rng.Collapse wdCollapseStart
            rng.Move wdCharacter, 5
            Set fld1 = ActiveDocument.Fields.Add(rng, wdFieldPage, , False)
            fld1.ShowCodes = True
            rng.Move wdCharacter, 9
            rng.InsertAfter "="
            rng.Move wdCharacter, 2
            Set fld1 = ActiveDocument.Fields.Add(rng, wdFieldNumPages, , False)
            fld1.ShowCodes = True
            rng.Move wdCharacter, 12
            Set fld1 = ActiveDocument.Fields.Add(rng, wdFieldFileName, " \p", False)
            fld1.ShowCodes = True
            fld.Update
            fld.ShowCodes = False
        End If
    Next ftr
End Sub
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 17873638
There shouldn't be any need to rerun if the file name or location change, but sometime between 2000 and 2003, the automatic update of fields on opening a document seems to have disappeared, so it is necessary to update fields some other way. Fields in the selection can be updated wthe F9 key. All fields in a document are updated when it is printed.

I've put an extra line of code in to do that if the field was already there.

'...
            If ftr.Range.Fields.Count > 3 Then
                If ftr.Range.Fields(1).Type = wdFieldIf Then
                    ftr.Range.Fields.Update '<--------
                    Exit Sub
                End If
            End If
'...
0
 
LVL 14

Expert Comment

by:Farzad Akbarnejad
ID: 17873763
Hello,
I test my code with Office 2000 and I get the proper result. But If you run it sone tines it insert some filename on the footer of the last page.

-FA
0
 
LVL 14

Expert Comment

by:Farzad Akbarnejad
ID: 17873766
Sorry, I test it with Office ~~~> 2003 <~~~
If you read my code you find that I added 'IF' statement accordinf to the posted link about Word Tips.

-FA
0
 

Author Comment

by:DetersLaw
ID: 17874542
GS,

Very nice.  The font size of the footer text is still 12pt, though.  Can you give it one more shot?

Thanks again!
0
 
LVL 76

Accepted Solution

by:
GrahamSkan earned 500 total points
ID: 17875805
I thought it was working. I guess my last tests were picking up the formatting already in the document from previous tests.

This tweaked version is tested on a new document.

Sub LastPageField()
    Dim rng As Range
    Dim ftr As HeaderFooter
    Dim fld As Field
    Dim fld1 As Field
    Dim f As Integer
    For Each ftr In ActiveDocument.Sections.Last.Footers
       If ftr.Exists Then
            If ftr.Range.Fields.Count > 3 Then
                If ftr.Range.Fields(1).Type = wdFieldIf Then
                    ftr.Range.Fields.Update
                    Exit Sub
                End If
            End If
            Set rng = ftr.Range
            rng.Collapse wdCollapseStart
            rng.ParagraphFormat.Alignment = wdAlignParagraphLeft
            Set fld = ActiveDocument.Fields.Add(rng, wdFieldIf, "  \* CHARFORMAT", False)
            fld.ShowCodes = True
            rng.MoveEnd wdCharacter, 5
            rng.Font.Name = "Times New Roman"
            rng.Font.Size = 8
            rng.Collapse wdCollapseEnd
            Set fld1 = ActiveDocument.Fields.Add(rng, wdFieldPage, , False)
            fld1.ShowCodes = True
            rng.Move wdCharacter, 9
            rng.InsertAfter "="
            rng.Move wdCharacter, 2
            Set fld1 = ActiveDocument.Fields.Add(rng, wdFieldNumPages, , False)
            fld1.ShowCodes = True
            rng.Move wdCharacter, 12
            Set fld1 = ActiveDocument.Fields.Add(rng, wdFieldFileName, " \p", False)
            fld.Update
        End If
    Next ftr
End Sub


0
 

Author Comment

by:DetersLaw
ID: 17876516
Perfect.

Thank you!
0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

I'm writing to share my clumsy experience in using this elegant tool so you can avoid every stupid mistake I made. (I leave it to the authorities to decide if this deserves a place in the Knowledge archives.)  Now that I am on the other side of my l…
Shortcuts in Word Just the other day I had a training for Microsoft and they wanted me to show how well the new Windows and Office behaved on a touch device, which by the way is great, but it was only then that I realized that using keyboard shortc…
Learn how to make your own table of contents in Microsoft Word using paragraph styles and the automatic table of contents tool. We'll be using the paragraph styles in Word’s Home toolbar to help you create a table of contents. Type out your initial …
Office 365 is currently available in five editions. Three of them are for business use: Office 365 Business Essentials, Office 365 Business, and Office 365 Business Premium. Two of them are for home/personal use: Office 365 Home and Office 365 Perso…

685 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question