Av8tordude
Well-known Member
- Joined
- Oct 13, 2007
- Messages
- 1,074
- Office Version
- 2019
- Platform
- Windows
This code create a calendar. I would like to create calendars for the whole year. The calendar setup example is listed below. How can I achieve this? Thanks
<tbody>
</tbody>
Code:
Sub CreateCalendar()
Dim csheet As Worksheet
Set csheet = ThisWorkbook.Sheets("Sheet1")
selDate = [b2]
fMon = DateSerial(Year(selDate), Month(selDate), 1)
lMon = CDate(Application.WorksheetFunction.EoMonth(fMon, 0))
stRow = 4
'clear last cal
Rows(4).ClearContents
Rows(6).ClearContents
Rows(8).ClearContents
Rows(10).ClearContents
Rows(12).ClearContents
Rows(14).ClearContents
'determine what weekday 1st is. . .
If Weekday(fMon) = 1 Then
stCol = 2
ElseIf Weekday(fMon) = 2 Then
stCol = 3
ElseIf Weekday(fMon) = 3 Then
stCol = 4
ElseIf Weekday(fMon) = 4 Then
stCol = 5
ElseIf Weekday(fMon) = 5 Then
stCol = 6
ElseIf Weekday(fMon) = 6 Then
stCol = 7
ElseIf Weekday(fMon) = 7 Then
stCol = 8
End If
Application.EnableEvents = False
For x = 1 To Day(lMon)
If FirstT = Empty Then
csheet.Cells(stRow, stCol) = fMon
FirstT = 1
Else
fMon = fMon + 1
csheet.Cells(stRow, stCol) = fMon
End If
If stCol = 8 Then
stCol = 2
stRow = stRow + 2
Else
stCol = stCol + 1
End If
Next x
Application.EnableEvents = True
End Sub
January | ||||||
Sunday | Monday | Tuesday | Wednesday | Thursday | Friday | Saturday |
1 | 2 | 3 | 4 | 5 | ||
6 | 7 | 8 | 9 | 10 | 11 | 12 |
13 | 14 | 15 | 16 | 17 | 18 | 19 |
20 | 21 | 22 | 23 | 24 | 25 | 26 |
27 | 28 | 29 | 30 | 31 | ||
February | ||||||
Sunday | Monday | Tuesday | Wednesday | Thursday | Friday | Saturday |
1 | 2 | |||||
3 | 4 | 5 | 6 | 7 | 8 | 9 |
10 | 11 | 12 | 13 | 14 | 15 | 16 |
17 | 18 | 19 | 20 | 21 | 22 | 23 |
24 | 25 | 26 | 27 | 28 | ||
March | ||||||
Sunday | Monday | Tuesday | Wednesday | Thursday | Friday | Saturday |
1 | 2 | |||||
3 | 4 | 5 | 6 | 7 | 8 | 9 |
10 | 11 | 12 | 13 | 14 | 15 | 16 |
17 | 18 | 19 | 20 | 21 | 22 | 23 |
24 | 25 | 26 | 27 | 28 | 29 | 30 |
31 | ||||||
<tbody>
</tbody>