| |
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
End Sub With a little
modifications you can also print pages dated sequentially for use as a daily
planner etc.:
Sub PrintSeqDatedCopies()
Dim i As Long
Dim d As Date
Dim pStrDate 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
d = DateAdd("d", i, d)
pStrDate = Format(d, "dddd MMM dd, yyyy")
oRng.Text = pStrDate
oRng.Font.Size = "36"
ActiveDocument.PrintOut
i = i + 1
Wend
End If
End Sub
|
|
