Help with Word VBA - Replacing text in TextBox

[CNorth]

Hi

I am trying to insert page numbers into TextBoxes in the document header in the format Page X of Y. Unfortunately, I cannot just use insert page numbering via the headers (or footers) as the document already contains a header that must remain as is and the TextBoxes must be positioned above it. Anyway, I decided to insert the string "Page X of " and use a counter to replace X. When testing the Sub below, I run into an error on the line

For Each counter In Selection.Range

I'd really appreciate any help to correct this.

Sub ReplaceInTextBox()

Dim shp As Shape
Dim counter As Long

 Selection.HomeKey Unit:=wdStory

a = ActiveDocument.BuiltInDocumentProperties("Number of Pages")
For i = 1 To a

Dim Box1 As Shape
    Set Box1 = ActiveDocument.Shapes.AddTextbox( _
    Orientation:=msoTextOrientationHorizontal, _
        Left:=65, Top:=1, Width:=150, Height:=30)
   
Box1.TextFrame.TextRange.Text = ActiveDocument.Name & Chr(10) & "Page X of " & a

  
counter = 0

  For Each shp In ActiveDocument.Shapes
        Selection.Select
            For Each counter In Selection.Range
            counter = counter + 1
            Next counter
  Next

   Selection.Find.ClearFormatting
   Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "X"
        .Replacement.Text = counter
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

Selection.GoTo What:=wdGoToPage, Which:=NextPage

End Sub

Thanks

 

[mart37]

Why do you not use the fields for pagenumber and number of pages?

    Box1.Select
    Selection.TypeText Text:="Page "
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:="PAGE  ", PreserveFormatting:=True
    Selection.TypeText Text:=" of "
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:="NUMPAGES  ", PreserveFormatting:=True

 

[mart37]

  For Each shp In ActiveDocument.Shapes
        Selection.Select
            For Each counter In Selection.Range
            counter = counter + 1
            Next counter
  Next

Replace with:

counter = ActiveDocument.Shapes.Count

 

[CNorth]

Thank you for your help. Adding fields worked. I also tried the code below to avoid the use of Selection but it generated an error with the counter variable stating the object was nothing.

counter = ActiveDocument.Shapes.Count

 

[mart37]

Strange. When the macro have one textbox added the line: ActiveDocument.Shapes.Count should be 1.

 

[Macropod]

Strange. When the macro have one textbox added the line: ActiveDocument.Shapes.Count should be 1.

ActiveDocument.Shapes.Count will not count shapes anywhere other than in the document body.

 

[Macropod]

Better, IMHO:

Sub AddPgNums()
Application.ScreenUpdating = False
Dim HdFt As HeaderFooter, Rng As Range, Tbl As Table
'Each Section in a Word document has 3 header & footer objects - primary, first page & even page
For Each HdFt In ActiveDocument.Sections(1).Headers
  With HdFt
  'Update each header that is being used in this document
    If .Exists = True Then
      Set Rng = .Range
      Rng.Collapse wdCollapseStart
      'Create a 2*1 table
      Set Tbl = Rng.Tables.Add(Range:=Rng, NumRows:=1, NumColumns:=2, _
        DefaultTableBehavior:=wdWord8TableBehavior, AutoFitBehavior:=wdAutoFitFixed)
        'Position, size, & format the table
      With Tbl
        With .Rows
          .WrapAroundText = True
          .RelativeVerticalPosition = wdRelativeVerticalPositionPage
          .VerticalPosition = InchesToPoints(0.25)
          .RelativeHorizontalPosition = wdRelativeHorizontalPositionMargin
          .HorizontalPosition = wdTableRight
        End With
        With .Rows(1)
          .HeightRule = wdRowHeightExactly
          .Height = InchesToPoints(0.25)
          .Cells.VerticalAlignment = wdCellAlignVerticalCenter
          With .Range.ParagraphFormat
            .SpaceBefore = 0
            .SpaceAfter = 0
          End With
        End With
        .Columns(1).Width = InchesToPoints(2)
        .Columns(2).Width = InchesToPoints(1)
        .Borders.Enable = False
        'Add a FILENAME field to the first cell
        Set Rng = .Cell(1, 1).Range
        With Rng
          .ParagraphFormat.Alignment = wdAlignParagraphLeft
          .End = .End - 1
          .Fields.Add Range:=.Duplicate, Type:=wdFieldEmpty, Text:="FILENAME", PreserveFormatting:=False
        End With
        'Add 'Page X of Y' text & corresponding PAGE & NUMPAGES fields to the second cell
        Set Rng = .Cell(1, 2).Range
        With Rng
          .ParagraphFormat.Alignment = wdAlignParagraphRight
          .End = .End - 1
          .Text = "Page X of Y"
          .Fields.Add Range:=.Characters.Last, Type:=wdFieldEmpty, Text:="NUMPAGES", PreserveFormatting:=False
          .Fields.Add Range:=.Characters(6), Type:=wdFieldEmpty, Text:="PAGE", PreserveFormatting:=False
        End With
      End With
    End If
  End With
Next
End Sub

Note that nothing is ever selected.

You may need to adjust the table position & cell sizes to suit the specifics of your document.