Dim x As Long, Rng As Range, Shp As Shape
With ActiveDocument
 
  For x = 1 To .ComputeStatistics(wdStatisticPages)
    Set Rng = .GoTo(What:=wdGoToPage, Name:=x)
    Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page")
    Rng.Collapse wdCollapseStart
    Set Shp = .Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
      Left:=0, Top:=0, Width:=100, Height:=40, Anchor:=Rng)
    With Shp
      .RelativeHorizontalPosition = wdRelativeHorizontalPositionMargin
      .Left = wdShapeRight
      .RelativeVerticalPosition = wdRelativeVerticalPositionMargin
      .Top = wdShapeTop
      .Fill.Visible = False
      With .TextFrame.TextRange
        .Font.Bold = True
        .Font.ColorIndex = wdBlue
        .Text = AlphaPortion & StrPre & (x + NumPortion) & vbCr & Me.TextBox2.Value & " " & Format(Now, "D MMM YYYY")
        .ParagraphFormat.SpaceAfter = 0
        Set Rng = .Paragraphs.First.Range
        With Rng
         .Font.ColorIndex = wdRed
        .End = .End - 1
          .Collapse wdCollapseEnd
        End With
 
      End With
    End With
  Next
End With
End Sub