VBA to insert a modified Page x of y in a Word Footer

I can insert "Page x of y" where "x" is wdFieldPage and "y" is wdFieldNumPages into a Word Footer resulting in:

"Page { PAGE } of { NUMPAGES }"

using the following code:

Sub InsertFooter()
        Dim rng As Range
    With ThisDocument.Sections(1)
        With .Footers(wdHeaderFooterPrimary)
          Set rng = .Range.Duplicate
            rng.Collapse wdCollapseEnd
            rng.InsertBefore vbTab & "Page  of "
            rng.Collapse wdCollapseStart
            rng.Move wdCharacter, 6
            ThisDocument.Fields.Add rng, wdFieldPage
            Set rng = .Range.Duplicate
            rng.Collapse wdCollapseEnd
            ThisDocument.Fields.Add rng, wdFieldNumPages
        End With
    End With
End Sub

How do I change this code to get:

"Page { = { PAGE } -1 } of { = { NUMPAGES } -1 }"

? ? ?
TimLitleAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

GrahamSkanRetiredCommented:
I find it difficult to keep track of where things are when using nested fields, so I have this cheat of entering the text and then translating it into fields with a generic procedure.
Sub InsertFooter()
    Dim rng As Range
    With ActiveDocument.Sections(1)
        With .Footers(wdHeaderFooterPrimary)
          Set rng = .Range.Duplicate
            rng.Collapse wdCollapseEnd
            rng.InsertBefore vbTab & "Page { = { PAGE } -1 } of { = { NUMPAGES } -1 }"
            TextToFields rng
        End With
    End With
End Sub
 
Sub TextToFields(rng1 As Range)
    Dim c As Range
    Dim fld As Field
    Dim f As Integer
    Dim rng2 As Range
    Dim lFldStarts() As Long
    
    Set rng2 = rng1.Duplicate
    rng1.Document.ActiveWindow.View.ShowFieldCodes = True
 
    For Each c In rng1.Characters
        DoEvents
        Select Case c.Text
            Case "{"
                ReDim Preserve lFldStarts(f)
                lFldStarts(f) = c.Start
                f = f + 1
            Case "}"
                f = f - 1
                If f = 0 Then
                    rng2.Start = lFldStarts(f)
                    rng2.End = c.End
                    rng2.Characters.Last.Delete '{
                    rng2.Characters.First.Delete '}
                    Set fld = rng2.Fields.Add(rng2, , , False)
                    Set rng2 = fld.Code
                    TextToFields fld.Code
                End If
            Case Else
        End Select
    Next c
    rng2.Expand wdStory
    rng2.Fields.Update
    rng1.Document.ActiveWindow.View.ShowFieldCodes = False
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
TimLitleAuthor Commented:
Your cheat is an approach I hadnt contemplated and I learned some interesting techniques from it.  I can step through the code and it works fine.  However, if I run it with no breaks, it blows up on line 36 every time with Run-time error 5904;  Cannot edit range.  I noticed you have a DoEvents at line 24 (why?) so I put a DoEvents before line 36 which didnt help.  I then added an On Error GoTo to Resume and try the failed instruction again.  This has worked in other situations but not here.  How do I fix this the problem and why dont either the DoEvents or On Error GoTo approaches work?
0
TimLitleAuthor Commented:
I still can't figure out how to prevent this blowing up on line 36.  I tried all kinds of things including lots of DoEvents and OnError statements although I have not tried running the code when the document is in Draft View instead of Print Layout View.

I eventually settled on code to achieve the following code in a footer containing:

            "Page xxx of yyy"

where both xxx  and yyy need to be the actual page numbers adjusted by the DocVariable "Pages Adjustment" so:

xxx becomes { = PAGE } + { DOCVARIABLE "Pages Adjustment" } } and
yyy becomes { = NUMPAGES } + { DOCVARIABLE "Pages Adjustment" }

The code that does this for both Odd and Even Footer pages is shown in the code snippet area:
    For i = 1 To 2
        docFooterFile.Sections(1).Footers(IIf(i Mod 2 = 0, wdHeaderFooterPrimary, wdHeaderFooterEvenPages)).Range.Select
        With Selection
            .Find.Execute findtext:="xxx", replacewith:=""
            .Fields.Add Range:=.Range, Type:=wdFieldEmpty, PreserveFormatting:=False
            .TypeText Text:="= "
            .Fields.Add Range:=.Range, Type:=wdFieldPage, PreserveFormatting:=False
            .TypeText Text:=" + "
            .Fields.Add Range:=.Range, Type:=wdFieldDocVariable, Text:="""Pages Adjustment""", PreserveFormatting:=False
            
            .Find.Execute findtext:="yyy", replacewith:=""
            .Fields.Add Range:=.Range, Type:=wdFieldEmpty, PreserveFormatting:=False
            .TypeText Text:="= "
            .Fields.Add Range:=.Range, Type:=wdFieldNumPages, PreserveFormatting:=False
            .TypeText Text:=" + "
            .Fields.Add Range:=.Range, Type:=wdFieldDocVariable, Text:="""Pages Adjustment""", PreserveFormatting:=False
        End With
    Next i

Open in new window

0
PMI ACP® Project Management

Prepare for the PMI Agile Certified Practitioner (PMI-ACP)® exam, which formally recognizes your knowledge of agile principles and your skill with agile techniques.

TimLitleAuthor Commented:
Oops, the following is correct:

xxx becomes { = { PAGE } + { DOCVARIABLE "Pages Adjustment" } } and
yyy becomes { = { NUMPAGES } + { DOCVARIABLE "Pages Adjustment" } }
0
TimLitleAuthor Commented:
I would still be interesting in knowing how to prevent your solution from blowing ip on line 36.  Can you re-create it?
0
GrahamSkanRetiredCommented:
Thanks Tim.
I was able to reproduce the problem with certain configurations of data. I have spent some time trying to rework it, but things got more and more complicated as each loophole was plugged. A complete rethink is probably necessary.
0
justin-clarkeCommented:
The original code by GrahamSkan works perfectly for me. This is a very good solution, just what aI was looking for.
0
justin-clarkeCommented:
^^ The original code by GrahamSkan works perfectly for me. This is a very good solution, just what I was looking for.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Word

From novice to tech pro — start learning today.