Datum/Schaltjahr/Februar
21.05.2004 19:51:57
Matthias
Ich habe folgendes Problem, in der beigefügtem code habe ich drei dropdown felder erstellt welche das Jahr, den Monat und die Tage des Monats in diesem Jahr wiedergibt, jedoch funktioniert das alles nicht wirklich, z.B. ist die auswahl des 29ten im Jahre 2005 im Februar möglich, was es eigentlich nicht dürfte, was kann ich da machen?
Danke für die antworten schon mal im vorraus...
"Diese Arbeitsmappe"
==================================================================
Private Sub Workbook_Open() Dim n As Integer Dim x As Integer Dim Letzter As Integer 'ComboBox 'cmbJahr' mit den Jahren füllen With Worksheets("Tabelle1").cmbJahr .Clear For n = 1990 To 2100 .AddItem n If n = Year(Date) Then x = n - 1990 + 1 Next n .ListIndex = x End With 'ComboBox 'cmbMonat' mit den Monatsnamen füllen With Worksheets("Tabelle1").cmbMonat .Clear For n = 1 To 12 .AddItem Format(DateSerial(2004, n, 1), "mmmm") If n = Month(Date) Then x = n - 1 Next n .ListIndex = x End With 'ComboBox 'cmbTag' mit den Tagen des Monats füllen 'Letzten Tag des aktuellen Monats bestimmen Letzter = DateSerial(Year(Date), Month(Date) + 1, 1) - _ DateSerial(Year(Date), Month(Date), 1) With Worksheets("Tabelle1").cmbTag .Clear For n = 1 To Letzter .AddItem n If n = Day(Date) Then x = n - 1 Next n .ListIndex = x End With "Tabelle1"
Private Sub cmbJahr_Change()
End Sub
Private Sub cmbMonat_Change()
Dim Monat As Integer
Dim Tag As Integer
Dim myJahr As Integer
Tag = Worksheets("Tabelle1").cmbTag.ListIndex
Monat = Worksheets("Tabelle1").cmbMonat.ListIndex + 1
'ComboBox 'cmbTag' mit den Tagen des Monats füllen
'Letzten Tag des aktuellen Monats bestimmen
Letzter = DateSerial(myJahr, Monat + 1, 1) - _
DateSerial(myJahr, Monat, 1)
With Worksheets("Tabelle1").cmbTag
.Clear
For n = 1 To Letzter
.AddItem n
Next n
'wenn möglich, den eingestellten Tag belassen
On Error GoTo errHandle
.ListIndex = Tag
Exit Sub
errHandle:
.ListIndex = -1
End With
End Sub
Private Sub cmbTag_Change()
End Sub
================================================================================