Hallo Liebe Vba experten,
Ich habe eine Datepicker form erstellt für eine Tabelle, jedoch habe ich 2 probleme:
1. Wenn man in der ComboBox ein anderer Monat ausgewählt wird, aktualisiert sich der Kalender nicht.
2. die Tage die nicht teil des Monats sind, sollten ausgegraut angezeigt werden dies ist leider nicht der fall.
'Declaring variables needed for the Datepickerform
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")
'populating the ComboBox with the Months
For i = 1 To 12
ComboBox1.AddItem Format(DateSerial(Year(Date), Month(Date) + i, 0), "mmmm")
Next
'Displaying the Current Month in the ComboBox
ComboBox1.ListIndex = Format(Date, "mm") - Format(Date, "mm")
'Populating the ComboBox with the next 10 Years
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
'white colour
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
'gray colour
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
|