Add Page Number To Footer-CodePudding

I've got a bunch of documents that I need to add page numbering in the footer.

I tried writing a macro to do this but after I run there's still no page numbers (in header or footer)

Sub AddPageNumberToFooter()
    Call DeleteExistingFooters
    
    With ActiveDocument
        .PageSetup.DifferentFirstPageHeaderFooter = False
        .Sections(1).Footers(wdHeaderFooterPrimary).PageNumbers.Add
    End With
End Sub
Sub DeleteExistingFooters()
    Dim iSectionCnt As Integer
    iSectionCnt = ActiveDocument.Sections.Count
    
    If iSectionCnt > 0 Then
        ActiveDocument.Sections(iSectionCnt).Footers(wdHeaderFooterPrimary).Range.Delete
    End If
    
End Sub

What am I missing?

CodePudding user response：

As you are writing that you have a bunch of documents: Could it be that ActiveDocument isn't the correct reference.

This works for me - you can replace ActiveDocument from the test-sub with any other document:

Option Explicit

Sub testPagenumbersForActiveDocument()

dim docToTest as Word.Document
set docToTest = ActiveDocument 'replace ActiveDocument with another doc you have opened

deleteExistingPageNumbers docToTest
addPageNumberToFooter docToTest

End Sub

Sub addPageNumberToFooter(doc As Word.Document)

With doc
    .PageSetup.DifferentFirstPageHeaderFooter = False
    .Sections(1).Footers(wdHeaderFooterPrimary).PageNumbers.Add
End With

End Sub


Sub deleteExistingPageNumbers(doc As Word.Document)

   Dim sec As Section, pn As PageNumber
    
    For Each sec In doc.Sections
        For Each pn In sec.Footers(wdHeaderFooterPrimary).PageNumbers
            pn.Delete
        Next
    Next
    
End Sub

The delete-sub only deletes PageNumbers - this is safer then your version as that will delete the whole footer-text ... which might be not what you want.

CodePudding user response：

The following code will add Page #s to all documents lacking them in every page in the selected folder:

Sub UpdateDocumentFooters()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String
Dim wdDoc As Document, Sctn As Section, HdFt As HeaderFooter
strFolder = GetFolder: If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
  If strFolder & "\" & strFile <> wdDocSrc.FullName Then
    Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, _
      AddToRecentFiles:=False, Visible:=False)
    With wdDoc
      For Each Sctn In .Sections
        For Each HdFt In Sctn.Footers
          With HdFt
            If .Exists Then
              If Sctn.Index = 1 Then
                Call AddPgFld(HdFt)
              ElseIf .LinkToPrevious = False Then
                Call AddPgFld(HdFt)
              End If
            End If
          End With
        Next
      Next
      .Close SaveChanges:=True
    End With
  End If
  strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub

Sub AddPgFld(HdFt As HeaderFooter)
Dim Fld As Field, bFld As Boolean
With HdFt
  bFld = False
  For Each Fld In .Range.Fields
    If Fld.Type = wdFieldPage Then
      bFld = True: Exit For
    End If
  Next
  If bFld = False Then
    With .Range.Paragraphs.Last.Range
      If Len(.Text) > 2 Then .InsertAfter vbCr
    End With
    With .Range.Paragraphs.Last.Range
      .Text = "Page "
      .Fields.Add Range:=.Characters.Last, Type:=wdFieldEmpty, Text:="PAGE", PreserveFormatting:=False
      .Alignment = wdAlignParagraphCenter
    End With
  End If
End With
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function