Insert auto date?

[Scott R]

Hi Guys, this is probably basic but im not that great with word.. I have made
a template which I want to print multiple copies of. I would like each copy
to have the next date at the top of the template.. ie page 1 = 1/03/08 page 2
= 2/08/08 etc.. Sort of like page numbering but with dates... is this
possible?? any suggestions would be much appreciated... thanks...

 

[Greg Maxey]

This coarsely adapted code to printed numered copies should work:

Sub PrintNumberedCopies()
Dim i As Long
Dim d As Date
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
d = CDate(InputBox("Enter the starting number.", _
"Starting Number", Date))
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 & " dated " & " copies of this document", _
vbYesNoCancel, "On your mark, get set ...?") = vbYes Then
While i < NumCopies
oRng.Delete
d = DateAdd("d", i, Date)
oRng.Text = d
ActiveDocument.PrintOut
i = i + 1
Wend
End If
End Sub

 

[Scott R]

That worked great thanks. Is there a way to change the format of the date to
include the day and also change the size?

 

[Greg Maxey]

Sub PrintNumberedCopies()
Dim i As Long
Dim d As Date
Dim pStr 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
d = CDate(InputBox("Enter the starting number.", _
"Starting Number", Date))
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 & " dated " & " copies of this document", _
vbYesNoCancel, "On your mark, get set ...?") = vbYes Then
While i < NumCopies
oRng.Delete
d = DateAdd("d", i, Date)
pStr = Format(d, "dddd MMM dd, yyyy")
oRng.Text = pStr
oRng.Font.Size = "36"
'ActiveDocument.PrintOut
i = i + 1
Wend
End If
End Sub

 

[Scott R]

Thanks heaps for that, worked a treat!

Sub PrintNumberedCopies()
Dim i As Long
Dim d As Date
Dim pStr 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
d = CDate(InputBox("Enter the starting number.", _
"Starting Number", Date))
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 & " dated " & " copies of this document", _
vbYesNoCancel, "On your mark, get set ...?") = vbYes Then
While i < NumCopies
oRng.Delete
d = DateAdd("d", i, Date)
pStr = Format(d, "dddd MMM dd, yyyy")
oRng.Text = pStr
oRng.Font.Size = "36"
'ActiveDocument.PrintOut
i = i + 1
Wend
End If
End Sub




--
Greg Maxey/Word MVP
See:
http://gregmaxey.mvps.org/word_tips.htm
For some helpful tips using Word.

 

[Scott R]

I have a problem with this code... for some reason regardless of what
'starting date' you use, it keeps starting from todays date... what am i
doing wrong??

 

[Graham Mayor]

Change the line

d = DateAdd("d", i, Date)
to
d = DateAdd("d", i, d)

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[Greg Maxey]

Graham is correct. Sorry.

I suppose that if this were something that I would use regularily then I
would incorporate a test for a valid date entry:

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

 

[Scott R]

Thanks guys, that worked great!!