Sub PrintMe()
Application.ScreenUpdating = False
Dim iStart As Long, iEnd As Long, iCount As Long, StrPages As String
On Error GoTo Done
With ActiveDocument
  iStart = .Sections.First.Headers(wdHeaderFooterPrimary).PageNumbers.StartingNumber
  If iStart = 0 Then iStart = 1
  iStart = InputBox("What is the First Number?", "Numbering Start From", iStart)
  iEnd = InputBox("What is the Last Number?", "Numbering Stop At", iStart)
  If IsNumeric(iStart) = False Or IsNumeric(iEnd) = False Then GoTo Done
  If iStart > iEnd Or iEnd = 0 Then GoTo Done
  iCount = iEnd - iStart
  If Len(.Range.Text) > 1 Then
    With .Styles("Page Number").Font
      .Size = 16
      .Name = "Arial"
      .Bold = True
    End With
    .Range.Cut
    With .Sections.First.Headers(wdHeaderFooterPrimary)
      .Range.Paste
      With .PageNumbers
        .Add PageNumberAlignment:=wdAlignPageNumberRight, FirstPage:=True
        .RestartNumberingAtSection = True
        .StartingNumber = iStart
      End With
    End With
  End If
  For iCount = iStart To iEnd - 1
    StrPages = StrPages & Chr(12)
  Next iCount
  .Range.InsertAfter StrPages
  With Application.Dialogs(wdDialogFilePrint)
    If .Show <> True Then iEnd = iStart - 1
  End With
  .Range.Delete
  .Sections.First.Headers(wdHeaderFooterPrimary).PageNumbers.StartingNumber = iEnd + 1
End With
Done:
Application.ScreenUpdating = True
End Sub