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