Excel Yearly Calendar To Store Your Notes

 Advanced Yearly Calendar With Multi Line Cells

       Record your notes, to-do, plans by day and time. Excel yearly calendar template, which is created automatically by the macro, with one sheet for each month of year, is very useful for the user in tasks such as calendar, keeping note,storing notes, to-do list, agenda and planning.

When the button that triggers the macro is clicked on the worksheet, an input box opens and it is learned from user about which for year the planner that it will be created.

Later on a new workbook ,a separate sheet is created for each month.The days of the month are sorted vertically on each sheet in column A. On the upper side, the times of day (from 09.00 to 20.00) is arranged horizontally as column headers. User can create a time-based recording (to-do, meeting, birthday, etc.). Notes can be entered into cells as multiple lines .For this ,we added WrapText = True feature to the codes.

➜ Month and day names are generated according to the user’s system language.

Finally, with a msgbox shown, it is posed to user that question of “Do you want to save the Excel yearly calendar?”.

Our VBA macro codes that allow us to create Excel yearly calendar : ↓

Sub Create_Yearly_Calendar()
  Dim i As Integer, x As Integer, alt As Integer
  Dim Worksh As Worksheet
  Dim Ans, messagelast As String
    
 Ans = Application.InputBox("Enter The Year To Create A Calendar", "Year Query", _
    IIf(Month(Date) > 9, Year(Date) + 1, Year(Date)))
 If Ans = False Then Exit Sub
  alt = Application.SheetsInNewWorkbook
  Application.SheetsInNewWorkbook = 12
  Workbooks.Add
  Application.SheetsInNewWorkbook = alt
  For i = 1 To 12
    Set Worksh = Worksheets(i)
    With Worksh.[A1:M3]
      .HorizontalAlignment = xlCenter
      .MergeCells = True
      .Font.Name = "Arial"
      .Font.Size = 20
      .Font.Bold = True
      .Font.Italic = True
      .Font.ColorIndex = 3
      .Interior.ColorIndex = 33  'Background Color Of Months Caption
      .NumberFormat = "mmmm yyyy"
    End With
    
    With Worksh
    .[B4] = "09:00"
    .[C4] = "10:00"
    .[D4] = "11:00"
    .[E4] = "12:00"
    .[F4] = "13:00"
    .[G4] = "14:00"
    .[H4] = "15:00"
    .[I4] = "16:00"
    .[J4] = "17:00"
    .[K4] = "18:00"
    .[L4] = "19:00"
    .[M4] = "20:00"
    .[B4:M4].Font.ColorIndex = 33
    End With
    
With Worksh
     .Hyperlinks.Add Anchor:=.Range("A38"), _
 Address:="https://merkez-ihayat.blogspot.com/", _
 TextToDisplay:="Click For More Templates"
    .[a1] = DateSerial(Ans, i, 1)
    .Name = Format(Worksh.[a1], "MMMM")
    .[A5:A37].NumberFormat = "DDD  DD.MM.YYYY"
    .[A5:A37].Font.ColorIndex = 3           'Font's Color In Column A
    .[A5:A37].Font.Bold = True
    .Columns(5).HorizontalAlignment = xlRight
End With
    For x = 0 To 30
    If Month(Worksh.[a1] + x) = Month(Worksh.Cells(x + 4, 1)) Or x = 0 Then
        Worksh.Cells(x + 5, 1) = Worksh.[a1] + x
    If Weekday(Worksh.Cells(x + 5, 1)) = 1 Then _
      Range(Worksh.Cells(x + 5, 1), Worksh.Cells(x + 5, 13)).Interior.ColorIndex = 34
    If Weekday(Worksh.Cells(x + 5, 1)) = 7 Then _
      Range(Worksh.Cells(x + 5, 1), Worksh.Cells(x + 5, 13)).Interior.ColorIndex = 35
    If Weekday(Worksh.Cells(x + 5, 1)) = 2 Then Worksh.Cells(x + 5, 1).AddComment _
      "MONDAY  " & DatePart("ww", Worksh.Cells(x + 5, 1), vbMonday, vbFirstFourDays)
    Worksh.Cells(x + 5, 1).Borders.Weight = xlThin
    With Range(Worksh.Cells(x + 5, 1), Worksh.Cells(x + 5, 13))
          .Borders(xlEdgeLeft).Weight = xlThin
          .Borders(xlEdgeTop).Weight = xlThin
          .Borders(xlEdgeBottom).Weight = xlThin
          .Borders(xlEdgeRight).Weight = xlThin
          .Borders.ColorIndex = 33            'Border Color

          .RowHeight = 36                     'Calendar Row Height

          .ColumnWidth = 28                   'Calendar Column Width

          .WrapText = True
    End With
        Worksh.Cells(1, 1).ColumnWidth = 15
      End If
    Next x
  Next i
  messagelast = MsgBox("Do You Want To Save This Workbook ?", vbYesNo)
  If messagelast = vbYes Then
  Application.Dialogs(xlDialogSaveAs).Show
  Else
  Exit Sub
  End If
End Sub