Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

Use VBA to insert page number in header of word document

Posted on 2012-09-17
2
Medium Priority
?
3,969 Views
Last Modified: 2012-09-18
I am using the following code to insert a custom header into a document from Page 2 forward.  I would like to include the page number as well.  I have tried two different solutions with no success -

1) Selection.Fields.Add rng, wdFieldPage (which results in an error - "Method Add of Object Fields Failed")
2) Selection.TypeText "Page " & Selection.Information(wdActiveEndPageNumber) & " of " & Selection.Information(wdNumberOfPagesInDocument) (which results in the same page number being inserted on every page)

Please help.

Public Sub InsertHeader()

Dim hdr As HeaderFooter
Dim txtClient As String
Dim txtProjectName As String
Dim txtDate As String
Dim intPage As Integer
Dim rng As Range


On Error GoTo InsertHeader_Err



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
   
txtClient = Application.ActiveDocument.FormFields("txtCompany").Result
txtProjectName = Application.ActiveDocument.FormFields("txtProjectName").Result
txtDate = Application.ActiveDocument.FormFields("txtdate").Result

Selection.GoTo wdGoToPage, 2
Selection.GoTo what:=wdGoToPage, which:=Selection.Information(wdActiveEndPageNumber)

Selection.InsertBreak wdSectionBreakContinuous

Set hdr = ActiveDocument.Sections(2).Headers(wdHeaderFooterPrimary)

hdr.LinkToPrevious = False



ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.EndKey Unit:=wdLine
Selection.Font.Name = "Futura BK BT"
Selection.TypeParagraph
Selection.TypeParagraph
Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
Selection.TypeText Text:=txtClient
Selection.TypeParagraph
Selection.TypeText txtProjectName
Selection.TypeParagraph
Selection.TypeText txtDate
Selection.TypeParagraph
'Selection.Fields.Add rng, wdFieldPage
'Selection.TypeText "Page " & Selection.Information(wdActiveEndPageNumber) & " of " & Selection.Information(wdNumberOfPagesInDocument)
Selection.TypeParagraph
Selection.TypeParagraph

ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument


Exit Sub

InsertHeader_Err:

MsgBox Err.Number & " " & Err.Description



End Sub
0
Comment
Question by:nquinn94
2 Comments
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 2000 total points
ID: 38408320
A couple of changes:

Public Sub InsertHeader()

Dim hdr As HeaderFooter
Dim txtClient As String
Dim txtProjectName As String
Dim txtDate As String
Dim intPage As Integer
Dim rng As Range


On Error GoTo InsertHeader_Err

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
    
txtClient = Application.ActiveDocument.FormFields("txtCompany").Result
txtProjectName = Application.ActiveDocument.FormFields("txtProjectName").Result
txtDate = Application.ActiveDocument.FormFields("txtdate").Result

Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:="2"
'Selection.GoTo wdGoToPage, 2
'Selection.GoTo what:=wdGoToPage, which:=Selection.Information(wdActiveEndPageNumber)

Selection.InsertBreak wdSectionBreakContinuous

Set hdr = ActiveDocument.Sections(2).Headers(wdHeaderFooterPrimary)

hdr.LinkToPrevious = False

ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.EndKey Unit:=wdLine
Selection.Font.Name = "Futura BK BT"
Selection.TypeParagraph
Selection.TypeParagraph
Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
Selection.TypeText Text:=txtClient
Selection.TypeParagraph
Selection.TypeText txtProjectName
Selection.TypeParagraph
Selection.TypeText txtDate
Selection.TypeParagraph
'Selection.Fields.Add rng, wdFieldPage
Selection.TypeText "Page "
Selection.Range.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
            "PAGE ", PreserveFormatting:=True
Selection.TypeText " of "
Selection.Range.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
            "NUMPAGES ", PreserveFormatting:=True
Selection.TypeParagraph
Selection.TypeParagraph

ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Exit Sub

InsertHeader_Err:
MsgBox Err.Number & " " & Err.Description

End Sub

Open in new window


Chris
0
 

Author Comment

by:nquinn94
ID: 38409897
That worked perfectly!  Thank you for your help!
0

Featured Post

Free learning courses: Active Directory Deep Dive

Get a firm grasp on your IT environment when you learn Active Directory best practices with Veeam! Watch all, or choose any amount, of this three-part webinar series to improve your skills. From the basics to virtualization and backup, we got you covered.

Question has a verified solution.

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

This article shows how to get a list of available printers for display in a drop-down list, and then to use the selected printer to print an Access report or a Word document filled with Access data, using different syntax as needed for working with …
In this post, I will showcase the steps for how to create groups in Office 365. Office 365 groups allow for ease of flexibility and collaboration between staff members.
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…
In this video you will find out how to export Office 365 mailboxes using the built in eDiscovery tool. Bear in mind that although this method might be useful in some cases, using PST files as Office 365 backup is troublesome in a long run (more on t…
Suggested Courses

810 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