Microsoft Word has a basic 12 ppt calendar, which is perfect for printing out
to use to flesh out employees work schedules. No extra colors, photos just
plain and simple. Microsoft should keep that basic design and offer it for
each calendar year. Also the calendars for the next year should be done and
available by June of the current year.

----------------
This post is a suggestion for Microsoft, and Microsoft responds to the
suggestions with the most votes. To vote for this suggestion, click the "I
Agree" button in the message pane. If you do not see the button, follow this
link to open the suggestion in the Microsoft Web-based Newsreader and then
click "I Agree" in the message pane.

http://www.microsoft.com/office/comm...ocmanagemen t

This allows you to create a calendar for any year you want at anytime you
want

' autonew Macro
' Macro created 11/14/98 by Doug Robbins to make calendar
' Modified 11/29/98 to add shading to weekends and "non-date" cells. '
Dim Message, Title, Default, Calyear, Thisyear, nyday
Thisyear = Year(Date)
Message = "Enter the year for which you want to create a calendar" '
Set prompt.
Title = "Calendar Maker" ' Set title.
Default = Thisyear ' Set default.
Calyear = InputBox(Message, Title, Default)
With ActiveDocument.PageSetup
.Orientation = wdOrientLandscape
.TopMargin = CentimetersToPoints(2)
.BottomMargin = CentimetersToPoints(1)
.LeftMargin = CentimetersToPoints(1.5)
.RightMargin = CentimetersToPoints(1)
End With
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=13,
NumColumns _
:=38
Selection.Tables(1).Select
Selection.Cells.SetHeight RowHeight:=38, HeightRule:=wdRowHeightExactly
Selection.Cells.SetWidth ColumnWidth:=CentimetersToPoints(0.65), RulerStyle
_
:=wdAdjustNone
Selection.Rows.SpaceBetweenColumns = CentimetersToPoints(0)
Selection.Font.Size = 8
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.SelectRow
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.SelectColumn
With Selection.Cells
With .Shading
.BackgroundPatternColorIndex = wdTurquoise
End With
End With
Counter = 1
While Counter 6
Selection.MoveRight Unit:=wdCharacter, Count:=6
Selection.Extend
Selection.MoveRight Unit:=wdCharacter, Count:=2
Selection.SelectColumn
With Selection.Cells
With .Shading
.BackgroundPatternColorIndex = wdTurquoise
End With
End With
Counter = Counter + 1
Wend
Selection.MoveLeft Unit:=wdCharacter, Count:=36
Dim days$(7)
days$(0) = "Sat": days$(1) = "Sun": days$(2) = "Mon": days$(3) = "Tue":
days$(4) = "Wed": days$(5) = "Thu": days$(6) = "Fri" ': days$(7) = "Sat"

Dim mon$(12)
mon$(1) = "January": mon$(2) = "February": mon$(3) = "March": mon$(4) =
"April": mon$(5) = "May": mon$(6) = "June": mon$(7) = "July": mon$(8) =
"August": mon$(9) = "September": mon$(10) = "October": mon$(11) =
"November": mon$(12) = "December"
Dim monthdays$(12)
If ((Calyear Mod 4 = 0 And Calyear Mod 400 = 0) Or (Calyear Mod 4 = 0
And Calyear Mod 100 0)) Then
monthdays$(1) = "32": monthdays$(2) = "30": monthdays$(3) = "32":
monthdays$(4) = "31": monthdays$(5) = "32": monthdays$(6) = "31":
monthdays$(7) = "32": monthdays$(8) = "32": monthdays$(9) = "31":
monthdays$(10) = "32": monthdays$(11) = "31": monthdays$(12) = "32" Else
monthdays$(1) = "32": monthdays$(2) = "29": monthdays$(3) = "32":
monthdays$(4) = "31": monthdays$(5) = "32": monthdays$(6) = "31":
monthdays$(7) = "32": monthdays$(8) = "32": monthdays$(9) = "31":
monthdays$(10) = "32": monthdays$(11) = "31": monthdays$(12) = "32" End
If
Colno = 1
rowno = 1
While Colno 38
ActiveDocument.Tables(1).Cell(1, Colno + 1).Range.InsertBefore
days$(Colno Mod 7)
Colno = Colno + 1
Wend
While rowno 13
ActiveDocument.Tables(1).Cell(rowno + 1, 1).Range.InsertBefore
Left(mon$(rowno), 3)
rowno = rowno + 1
Wend
rowno = 1
While rowno 13
Counter = 1
dayone = WeekDay(mon$(rowno) & " 1," & Calyear) If dayone
Mod 7 = 0 Then
Colno = 8
Else
Colno = (dayone Mod 7) + Counter
End If
Painter = 2
While Painter Colno
ActiveDocument.Tables(1).Cell(rowno + 1,
Painter).Shading.BackgroundPatternColorIndex = wdTurquoise
Painter = Painter + 1
Wend
While Counter Val(monthdays$(rowno))
ActiveDocument.Tables(1).Cell(rowno + 1,
Colno).Range.InsertBefore Counter
Colno = Colno + 1
Counter = Counter + 1
Wend
While Colno 39
ActiveDocument.Tables(1).Cell(rowno + 1,
Colno).Shading.BackgroundPatternColorIndex = wdTurquoise
Colno = Colno + 1
Wend
rowno = rowno + 1
Wend
Selection.SelectRow
Selection.Cells.HeightRule = wdRowHeightAuto
Selection.InsertRows 1
Selection.Cells.Merge
Selection.Font.Size = 18
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.InsertAfter Calyear
End Sub



--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP
"djennings" wrote in message
...
Microsoft Word has a basic 12 ppt calendar, which is perfect for printing
out
to use to flesh out employees work schedules. No extra colors, photos just
plain and simple. Microsoft should keep that basic design and offer it for
each calendar year. Also the calendars for the next year should be done
and
available by June of the current year.

----------------
This post is a suggestion for Microsoft, and Microsoft responds to the
suggestions with the most votes. To vote for this suggestion, click the "I
Agree" button in the message pane. If you do not see the button, follow
this
link to open the suggestion in the Microsoft Web-based Newsreader and then
click "I Agree" in the message pane.

http://www.microsoft.com/office/comm...ocmanagemen t