Print Numbered (or Dated) Copies
(A Microsoft Word Help & Tip page by Gregory K. Maxey)

Sub PrintNumberedCopies()
Dim NumCopies As String
Dim StartNum As String
Dim Counter As Long
Dim oRng As Range
  If MsgBox("The copy number will appear at the insertion point." _
          & " Is the cursor at the correct position?", _
           vbYesNo, "Placement") = vbNo Then End
  If ActiveDocument.Saved = False Then
    If MsgBox("Do you want to save any changes before" & _
              " printing?", vbYesNoCancel, "Save document?") = vbYes Then
      ActiveDocument.Save
    End If
  End If
  StartNum = Val(InputBox("Enter the starting number.", "Starting Number", 1))
  NumCopies = Val(InputBox("Enter the number of copies that" & _
                           " you want to print", "Copies", 1))
  ActiveDocument.Bookmarks.Add Name:="CopyNum", Range:=Selection.Range
  Set oRng = ActiveDocument.Bookmarks("CopyNum").Range
  Counter = 0
  If MsgBox("Are you sure that you want to print " _
            & NumCopies & " numbered " & " copies of this document", _
            vbYesNoCancel, "On your mark, get set ...?") = vbYes Then
    While Counter < NumCopies
      oRng.Delete
      oRng.Text = StartNum
      ActiveDocument.PrintOut
      StartNum = StartNum + 1
      Counter = Counter + 1
    Wend
  End If
lbl_Exit:
  Exit Sub
End Sub

Sub PrintSeqDatedCopies()
Dim i As Long
Dim d As Date
Dim strDate As String
Dim oRng As Range
Dim NumCopies As Long
  If MsgBox("The date will appear at the insertion point." _
          & " Is the cursor at the correct position?", _
          vbYesNo, "Placement") = vbNo Then End
  If ActiveDocument.Saved = False Then
    If MsgBox("Do you want to save any changes before" & _
              " printing?", vbYesNoCancel, "Save document?") = vbYes Then
      ActiveDocument.Save
    End If
  End If
  On Error Resume Next
Date_Err_Reentry:
  d = CDate(InputBox("Enter the starting date.", "Starting Number", Date))
  If Err.Number = 13 Then
    MsgBox "Invalid date format"
    Err.Clear
    GoTo Date_Err_Reentry
  End If
  On Error GoTo 0
  NumCopies = Val(InputBox("Enter the number of copies that" & _
                           " you want to print", "Copies", 1))
  ActiveDocument.Bookmarks.Add Name:="Date", Range:=Selection.Range
  Set oRng = ActiveDocument.Bookmarks("Date").Range
  i = 0
  If MsgBox("Are you sure that you want to print " _
            & NumCopies & " sequentially dated " & " copies of this document", _
            vbYesNoCancel, "Print Confrimation") = vbYes Then
    While i < NumCopies
      oRng.Delete
      strDate = Format(d, "dddd MMM dd, yyyy")
      d = DateAdd("d", 1, d)
      oRng.Text = strDate
      oRng.Font.Size = "36"
      ActiveDocument.PrintOut
      i = i + 1
    Wend
  End If
lbl_Exit:
  Exit Sub
End Sub