I rearranged the 12-month calendar from the Office site so it starts
the week on Sunday. You can download it from
http://members.verizon.net/~vze27sds/2004_calendar.doc.

You can also print monthly calendars from the calendar view in
Outlook. I like them better than any of the ones I've see in Word.

--
Regards,
Jay Freedman
Microsoft Word MVP        FAQ: http://www.mvps.org/word

Hi Kim,

The following macro will ask what year you want the calendar for and then
create it for the year that you entered:

' 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

Please post any further questions or followup to the newsgroups for the
benefit of others who may be interested.  Unsolicited questions forwarded
directly to me will only be answered on a paid consulting basis.

Hope this helps
Doug Robbins - Word MVP