Feiertage im Kalender
28.11.2006 23:08:33
Dirk T.
habe mit Eurer Hilfe folgenden Code erstellt, funzt auch so wie es soll,
habe beim erweitern nur so meine lieben Probleme,
als erstes möchte ich bei Neujahr, Weihnachten usw. zusätzlich ein Kommentar in die Datumszelle einfügen, mit dem Ergebnis das in jeder Zeile "Neujahr" ist :-(
was mache ich da falsch????
das 2. Problem ist, wenn der 4. Advent gleich Heiligabend ist (wie dieses Jahr zum Beispiel) soll in der 3. Spalte 4.Adv., Heiligabend stehen,
und sonst halt 4. Advent bzw. Heiligabend
wie kann ich das realisieren, habe schon einiges versucht????
wo ich dann auch beim 3. Problem wäre
Muttertag ist ja bekanntlich am 2. Sonntag im Mai, außer wenn an dem Tag Pfingsten ist, dann ist Muttertag eine Woche eher.
Denke mir das ist die gleiche Problematik wie beim Heiligen Abend.
Wer kann mir da weiterhelfen??????
Private Sub Workbook_Open()
Dim lngZ As Long, datT As Date
Dim d_b
Dim d_Ostersonntag As Date
Dim A, D, E As Integer
Worksheets("Kalender").Select
lngZ = Cells(Rows.Count, 1).End(xlUp).Row
datT = DateSerial(Year(Date) + 2, Month(Date) + 6, Day(Date))
While Cells(lngZ, 2) < datT
Range(Cells(lngZ, 1), Cells(lngZ, 2)).Copy Cells(lngZ + 1, 1)
Cells(lngZ + 1, 2) = Cells(lngZ, 2) + 1
lngZ = lngZ + 1
Cells(lngZ, 1) = Format(Cells(lngZ, 2), "ddd")
d_b = Cells(lngZ, 2)
d_b = Format(Cells(lngZ, 2), "yyyy") 'ermittelt Jahr
Select Case Cells(lngZ, 2)
Case Is = CDate("01.01." & d_b)
Cells(lngZ, 2).Font.ColorIndex = 46
Cells(lngZ, 1).Font.ColorIndex = 46
Cells(lngZ, 1).Font.Bold = True
Cells(lngZ, 2).Font.Bold = True
Cells(lngZ, 3) = "Neujahr"
'Range("B" & lngZ).AddComment (" Neujahr ")
Case CDate("25.12." & d_b) - Weekday("25.12." & d_b, vbMonday), Is <= "23.12." & d_b > CDate("25.12." & d_b) - Weekday("25.12." & d_b, vbMonday) - 7
Cells(lngZ, 3) = " 4. Advent"
Case Is = CDate("24.12." & d_b), Is = CDate("25.12." & d_b) - Weekday("25.12." & d_b, vbMonday)
' Case Is = CDate("25.12." & d_b) - Weekday("25.12." & d_b, vbMonday), Is = "24.12." & d_b
Cells(lngZ, 3) = "4.Adv., Heiliger Abend"
'Case CDate("24.12." & d_b) = CDate("25.12." & d_b) - Weekday("25.12." & d_b, vbMonday)
' Cells(lngZ, 3) = "4.Adv HeiligAbend"
Case Is = CDate("24.12." & d_b)
Cells(lngZ, 1).Font.Bold = True
Cells(lngZ, 2).Font.Bold = True
Cells(lngZ, 3) = "Heiligabend"
End Select
'If CDate("24.12." & d_b) = CDate("25.12." & d_b) - Weekday("25.12." & d_b, vbMonday) Then
'If CDate("25.12." & d_b) - Weekday("25.12." & d_b, vbMonday) = CDate("24.12." & d_b) Then
Wend
Columns(2).Find(Date).Offset(0, 2).Select
End Sub
Bedanke mich schon einmal im Vorraus für Eure Hilfe
Dirk