• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 4253
  • Last Modified:

Use VBA to insert page number in header of word document

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
nquinn94
Asked:
nquinn94
1 Solution
 
Chris BottomleySoftware Quality Lead EngineerCommented:
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
 
nquinn94Director of AdministrationAuthor Commented:
That worked perfectly!  Thank you for your help!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Cloud Class® Course: Amazon Web Services - Basic

Are you thinking about creating an Amazon Web Services account for your business? Not sure where to start? In this course you’ll get an overview of the history of AWS and take a tour of their user interface.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now