Solved

VBA macro for simple last page footer

Posted on 2006-11-03
13
3,589 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
 
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
Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

 
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

6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

Join & Write a Comment

The Selection object is designed for user interaction. It has a Range property, so it can be used in most places that a Range object can. Recorded macros must use the Selection because they are simply copying what the user is doing. A Range prope…
Microsoft Word is a program we have all encountered at some point, but very few of us have dug deep into its full scope of features, let alone customized it to suit our needs. Luckily making the ribbon (aka toolbar, first introduced in Word 2007) wo…
The viewer will learn how to make their project stand out over others by learning how to change colors and shapes, add spaces, change directions, and add bullets to their charts.
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…

708 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

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now