Dim ThisDay As Date
Dim ThisYear As Date
Dim ThisMonth As Date
Dim CreateCal As Boolean
Dim i As Integer
Private Sub CommandButton1_Click()
ActiveCell.Value = Now() + 7
End Sub
Private Sub CommandButton2_Click()
ActiveCell.Value = Now() + 14
Unload Me
End Sub
Private Sub CommandButton3_Click()
ActiveCell.Value = Now()
End Sub
Private Sub D1_Click()
Selection.Value = Me.D1.ControlTipText
Unload Me
End Sub
Private Sub D2_Click()
Selection.Value = Me.D2.ControlTipText
Unload Me
End Sub
Private Sub D3_Click()
Selection.Value = Me.D3.ControlTipText
Unload Me
End Sub
Private Sub D4_Click()
Selection.Value = Me.D4.ControlTipText
Unload Me
End Sub
Private Sub D5_Click()
Selection.Value = Me.D5.ControlTipText
Unload Me
End Sub
Private Sub D6_Click()
Selection.Value = Me.D6.ControlTipText
Unload Me
End Sub
Private Sub D7_Click()
Selection.Value = Me.D7.ControlTipText
Unload Me
End Sub
Private Sub D8_Click()
Selection.Value = Me.D8.ControlTipText
Unload Me
End Sub
Private Sub D9_Click()
Selection.Value = Me.D9.ControlTipText
Unload Me
End Sub
Private Sub D10_Click()
Selection.Value = Me.D10.ControlTipText
Unload Me
End Sub
Private Sub D11_Click()
Selection.Value = Me.D11.ControlTipText
Unload Me
End Sub
Private Sub D12_Click()
Selection.Value = Me.D12.ControlTipText
Unload Me
End Sub
Private Sub D13_Click()
Selection.Value = Me.D13.ControlTipText
Unload Me
End Sub
Private Sub D14_Click()
Selection.Value = Me.D14.ControlTipText
Unload Me
End Sub
Private Sub D15_Click()
Selection.Value = Me.D15.ControlTipText
Unload Me
End Sub
Private Sub D16_Click()
Selection.Value = Me.D16.ControlTipText
Unload Me
End Sub
Private Sub D17_Click()
Selection.Value = Me.D17.ControlTipText
Unload Me
End Sub
Private Sub D18_Click()
Selection.Value = Me.D18.ControlTipText
Unload Me
End Sub
Private Sub D19_Click()
Selection.Value = Me.D19.ControlTipText
Unload Me
End Sub
Private Sub D20_Click()
Selection.Value = Me.D20.ControlTipText
Unload Me
End Sub
Private Sub D21_Click()
Selection.Value = Me.D21.ControlTipText
Unload Me
End Sub
Private Sub D22_Click()
Selection.Value = Me.D22.ControlTipText
Unload Me
End Sub
Private Sub D23_Click()
Selection.Value = Me.D23.ControlTipText
Unload Me
End Sub
Private Sub D24_Click()
Selection.Value = Me.D24.ControlTipText
Unload Me
End Sub
Private Sub D25_Click()
Selection.Value = Me.D25.ControlTipText
Unload Me
End Sub
Private Sub D26_Click()
Selection.Value = Me.D26.ControlTipText
Unload Me
End Sub
Private Sub D27_Click()
Selection.Value = Me.D27.ControlTipText
Unload Me
End Sub
Private Sub D28_Click()
Selection.Value = Me.D28.ControlTipText
Unload Me
End Sub
Private Sub D29_Click()
Selection.Value = Me.D29.ControlTipText
Unload Me
End Sub
Private Sub D30_Click()
Selection.Value = Me.D30.ControlTipText
Unload Me
End Sub
Private Sub D31_Click()
Selection.Value = Me.D31.ControlTipText
Unload Me
End Sub
Private Sub D32_Click()
Selection.Value = Me.D32.ControlTipText
Unload Me
End Sub
Private Sub D33_Click()
Selection.Value = Me.D33.ControlTipText
Unload Me
End Sub
Private Sub D34_Click()
Selection.Value = Me.D34.ControlTipText
Unload Me
End Sub
Private Sub D35_Click()
Selection.Value = Me.D35.ControlTipText
Unload Me
End Sub
Private Sub D36_Click()
Selection.Value = Me.D36.ControlTipText
End Sub
Private Sub D37_Click()
Selection.Value = Me.D37.ControlTipText
Unload Me
End Sub
Private Sub D38_Click()
Selection.Value = Me.D38.ControlTipText
Unload Me
End Sub
Private Sub D39_Click()
Selection.Value = Me.D39.ControlTipText
Unload Me
End Sub
Private Sub D40_Click()
Selection.Value = Me.D40.ControlTipText
Unload Me
End Sub
Private Sub D41_Click()
Selection.Value = Me.D41.ControlTipText
Unload Me
End Sub
Private Sub D42_Click()
Selection.Value = Me.D42.ControlTipText
Unload Me
End Sub
Private Sub UserForm_Initialize()
Application.EnableEvents = False
ThisDay = Date
ThisMonth = Format(ThisDay, "mm")
ThisYear = Format(ThisDay, "yyyy")
For i = 1 To 12
ComboBox1.AddItem Format(DateSerial(Year(Date), Month(Date) + i, 0), "mmmm")
Next
ComboBox1.ListIndex = Format(Date, "mm") - Format(Date, "mm")
For i = 1 To 10
If i = 1 Then ComboBox2.AddItem Format(ThisDay, "yyyy") Else ComboBox2.AddItem Format((DateAdd("yyyy", (i - 1), ThisDay)), "yyyy")
Next
ComboBox2.ListIndex = 0
CreateCal = True
Call BuildCal
Application.EnableEvents = True
CommandButton3.Caption = Format(Date)
End Sub
Private Sub BuildCal()
For i = 1 To 42
If i < Weekday((ComboBox1.Value) & "/2/" & (ComboBox2.Value)) Then
Controls("D" & (i)).Caption = Format(DateAdd("d", (i - Weekday((ComboBox1.Value) & "/2/" & (ComboBox2.Value))), _
((ComboBox1.Value) & "/2/" & (ComboBox2.Value))), "d")
Controls("D" & (i)).ControlTipText = Format(DateAdd("d", (i - Weekday((ComboBox1.Value) & "/2/" & (ComboBox2.Value))), _
((ComboBox1.Value) & "/2/" & (ComboBox2.Value))), "dd.mm.yyyy")
ElseIf i >= Weekday((ComboBox1.Value) & "/1/" & (ComboBox2.Value)) Then
Controls("D" & (i)).Caption = Format(DateAdd("d", (i - Weekday((ComboBox1.Value) & "/2/" & (ComboBox2.Value))), _
((ComboBox1.Value) & "/2/" & (ComboBox2.Value))), "d")
Controls("D" & (i)).ControlTipText = Format(DateAdd("d", (i - Weekday((ComboBox1.Value) & "/2/" & (ComboBox2.Value))), _
((ComboBox1.Value) & "/2/" & (ComboBox2.Value))), "dd.mm.yyyy")
End If
If Format(DateAdd("d", (i - Weekday((ComboBox1.Value) & "/2/" & (ComboBox2.Value))), _
((ComboBox1.Value) & "/2/" & (ComboBox2.Value))), "mmmm") = ((ComboBox1.Value)) Then
If Controls("D" & (i)).BackColor <> &HFFFFFF Then Controls("D" & (i)).BackColor = &HFFFFFF
Controls("D" & (i)).Font.Bold = True
If Format(DateAdd("d", (i - Weekday((ComboBox1.Value) & "/1/" & (ComboBox2.Value))), _
((ComboBox1.Value) & "/2/" & (ComboBox2.Value))), "d/m/yyyy") = Format(ThisDay, "d/m/yy") Then Controls("D" & (i)).SetFocus
Else
If Controls("D" & (i)).BackColor <> &H80000016 Then Controls("D" & (i)).BackColor = &H8000000F
Controls("D" & (i)).Font.Bold = False
End If
Next
End Sub