Geburtstage rückwirkend anzeigen
07.12.2004 09:18:33
Andreas
untenstehender Code hatte ich hier aus dem Forum.Er zeigt mir Geburtstage an per Msg-Box.Das Geburtsdatum steht in Spalte C. Wie ändere ich den Code das er mir auch eine Meldung ausgibt wenn jemand gestern bzw.vorgestern Geburtstag hatte.
Es ist eine Mitarbeiterliste und wenn sie Montags geöffnet wird und jemand hatte Samstags Geburtstag soll er auch noch angezeigt werden.
Vielen Dank
Andreas
Private Sub Workbook_Open()
Dim lZeile, i, Geb
Worksheets("Mitarbeiter").Select
Geb = 10
Columns(1).Interior.ColorIndex = xlNone
lZeile = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lZeile
If Month(Cells(i, 3)) = Month(Date) And Day(Cells(i, 3)) = Day(Now) Then
MsgBox Cells(i, 1) & ", " & Cells(i, 2) & Chr(13) & "hat heute Geburtstag" & Chr(13) _
& "und wird " & DateDiff("yyyy", Cells(i, 3), Date) & " Jahre alt"
Cells(i, 1).Interior.ColorIndex = 4
End If
If DateDiff("d", DateSerial(Year(Now + Geb), Month(Cells(i, 3)), Day(Cells(i, 3))), Date) > Geb * -1 And _
DateDiff("d", DateSerial(Year(Now + Geb), Month(Cells(i, 3) + Geb), Day(Cells(i, 3) + Geb)), Date) < Geb * -1 Then
MsgBox Cells(i, 1) & ", " & Cells(i, 2) & Chr(13) & "hat am" & Chr(13) _
& DateSerial(Year(Now), Month(Cells(i, 3)), Day(Cells(i, 3))) _
& " Geburtstag"
Cells(i, 1).Interior.ColorIndex = 35
End If
Next i
End Sub