I am not really sure what makes a calendar "Academic", but the following
macro will ask you for what year you want to create a calendar and then it
will create one for that year.

' 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