Excel Yearly Planner Spreadsheet - Agenda

A Yearly Calendar With Multi Line Cells To Store Your Notes


         Create Yearly Planning Spreadsheet &Agenda In Your Own Language.

When you click the button on the worksheet , the inputbox opens to learn if you want to create a calendar which the year.
Instantly , the calendar for the year you want is created by the macro in new workbook .
         
          A separate worksheet is created for each month.
The days of the month are sorted vertically on each worksheet in column A.
On the upper side, the time of day (09.00 - 20.00) is arranged horizontally. You can create a time-based recording (to-do, meeting, birthday, etc.).

         Data can be entered into cells as multiple lines .For this ,we added "WrapText = True" option to codes.


VBA codes of the calendar macro :
Sub Create_Calendar()
Dim i As Integer, x As Integer, alt As Integer
Dim WS 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 WS = Worksheets(i)
With WS.[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 WS
.[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 WS
.Hyperlinks.Add Anchor:=.Range("A38"), _
Address:="http://merkez-ihayat.blogspot.com", _
TextToDisplay:="Click For More Templates"
End With

WS.[a1] = DateSerial(Ans, i, 1)
WS.Name = Format(WS.[a1], "MMMM")
WS.[A5:A37].NumberFormat = "DDD DD.MM.YYYY"
WS.[A5:A37].Font.ColorIndex = 3 'Font Color In Column A
WS.[A5:A37].Font.Bold = True
WS.Columns(5).HorizontalAlignment = xlRight
For x = 0 To 30
If Month(WS.[a1] + x) = Month(WS.Cells(x + 4, 1)) Or x = 0 Then
WS.Cells(x + 5, 1) = WS.[a1] + x
If Weekday(WS.Cells(x + 5, 1)) = 1 Then _
Range(WS.Cells(x + 5, 1), WS.Cells(x + 5, 13)).Interior.ColorIndex = 34
If Weekday(WS.Cells(x + 5, 1)) = 7 Then _
Range(WS.Cells(x + 5, 1), WS.Cells(x + 5, 13)).Interior.ColorIndex = 35
If Weekday(WS.Cells(x + 5, 1)) = 2 Then WS.Cells(x + 5, 1).AddComment _
"MONDAY " & DatePart("ww", WS.Cells(x + 5, 1), vbMonday, vbFirstFourDays)
WS.Cells(x + 5, 1).Borders.Weight = xlThin
With Range(WS.Cells(x + 5, 1), WS.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
WS.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


No comments:

Post a Comment