Geburtstag in Messagebox anzeigen...

Moin zusammen im Excel-Forum.
Ich habe ein kleines Anliegen, Problem, wie auch immer...
In einer Tabelle habe ich Geburtstage eingegeben. Nun möchte ich gerne, das eine Messagebox den Namen und das Alter anzeigt, wenn jemand heute Geburtstag hat und anschließend die Geburtstage der nächsten 10 Tage mit Namen und Alter ausgibt.
Die Daten sollen die MsgBoxen aus der Tabelle1 beziehen (Vorname Zellen e4:e131, Nachname c4:c131, Geb.-Datum h4:h131, das Alter j4:j131)
Beispiel MsgBox 1:
Geburtstag heute:
Max Mustermann wird heute 30 Jahre.
Falls heute kein Geburtstag anliegt Meldung: Heute kein Geburtstag!
anschließend soll MsgBox 2 Geburtstage der nächsten 10 Tage anzeigen:
Geburtstage in den nächsten 10 Tagen:
Gerd Hausmann wird heute am 01.01.2015 48 Jahre.
Falls keine Geburtstag anliegt Meldung: Keine Geburtstage in den nächsten 10 Tagen!
Kann und wenn ja wie kann das realisiert werden? Hat jemend eine Idee?
Wer hat evtl. sogar einen Code dafür? Danke für jede Hilfe!
Ich hoffe, das ich mein Problem einigermaßen verständlich beschrieben habe?
LG Ina

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Hajo,
danke für deine Mithilfe, aber das ist noch nicht so recht das, was ich suche...
Ich hatte irgendwann im Forum einen Beitrag mit der Anzeige in einer MsgBox gefunden und versucht, den Code an meine Belasnge anzupassen - aber ich habe leider noch zu wenig Ahnung von der Materie. Irgendetwas ist falsch, jedenfalls klappt das nicht so wie gewünscht.
Hier der Code:

Private Sub GEBURTSTAGS_INFO()
Dim sMldg1 As String, sMldg2 As String, lR As Long, iDiff As Integer
Const iNn As Integer = 3   ' Spalte C - Nachnamen
Const iVn As Integer = 5   ' Spalte E - Vornamen
Const iG As Integer = 8    ' Spalte H - Geburtsdatum
Beep
sMldg1 = "Geburtstage heute:" & vbLf
lR = 4
Do Until IsEmpty(Cells(lR, iVn))
iDiff = DateSerial(Year(Date), Month(Cells(lR, iG)), Day(Cells(lR, iG))) - Date
If iDiff < 0 Then _
iDiff = DateSerial(1 + Year(Date), Month(Cells(lR, iG)), Day(Cells(lR, iG))) - Date
Select Case iDiff
Case 0
sMldg1 = sMldg1 & vbLf & Cells(lR, iG) & " - " & Cells(lR, iVn) & " " & _
Cells(lR, iNn) & " wird heute " & Year(Date) - Year(Cells(lR, iG)) & _
" Jahre alt!"
Case 1 To 10
sMldg2 = sMldg2 & vbLf & Cells(lR, iG) & " - " & Cells(lR, iVn) & " " & _
Cells(lR, iNn) & " wird in " & " " & Format(iDiff, "00") & " Tag(en) " & " " & _
Year(Date) - Year(Cells(lR, iG)) & " Jahre alt!"
End Select
lR = lR + 1
Loop
If sMldg1 = "Geburtstage:" & vbLf Then sMldg1 = "Heute kein Geburtstag!"
If MsgBox(sMldg1, vbOKCancel, " GEBURTSTAGS-INFO...") = vbOK Then
If sMldg2 <> "" Then
MsgBox "Geburtstage in den nächsten 10 Tagen:" & vbLf & sMldg2, , " GEBURTSTAGS-INFO... _
Else
MsgBox "Keine Geburtstage in den nächsten 10 Tagen!", , " GEBURTSTAGS-INFO..."
End If
End If
End Sub

Was habe ich falsch gemacht?
LG Ina

Private Sub GEBURTSTAGS_INFO() Dim sMldg1 As String, sMldg2 As String, lR As Long, iDiff As Integer Const iNn As Integer = 3 ' Spalte C - Nachnamen Const iVn As Integer = 5 ' Spalte E - Vornamen Const iG As Integer = 8 ' Spalte H - Geburtsdatum Beep sMldg1 = "Geburtstage heute:" & vbLf lR = 4 Do Until IsEmpty(Cells(lR, iVn)) iDiff = DateSerial(Year(Date), Month(Cells(lR, iG)), Day(Cells(lR, iG))) - Date If iDiff < 0 Then _ iDiff = DateSerial(1 + Year(Date), Month(Cells(lR, iG)), Day(Cells(lR, iG))) - Date Select Case iDiff Case 0 sMldg1 = sMldg1 & vbLf & Cells(lR, iG) & " - " & Cells(lR, iVn) & " " & _ Cells(lR, iNn) & " wird heute " & Year(Date) - Year(Cells(lR, iG)) & _ " Jahre alt!" Case 1 To 10 sMldg2 = sMldg2 & vbLf & Cells(lR, iG) & " - " & Cells(lR, iVn) & " " & _ Cells(lR, iNn) & " wird in " & " " & Format(iDiff, "00") & " Tag(en) " & " " & _ Year(Date) - Year(Cells(lR, iG)) & " Jahre alt!" End Select lR = lR + 1 Loop If sMldg1 = "Geburtstage:" & vbLf Then sMldg1 = "Heute kein Geburtstag!" If MsgBox(sMldg1, vbOKCancel, " GEBURTSTAGS-INFO...") = vbOK Then If sMldg2 <> "" Then MsgBox "Geburtstage in den nächsten 10 Tagen:" & vbLf & sMldg2, , " GEBURTSTAGS-INFO... _ _ Else MsgBox "Keine Geburtstage in den nächsten 10 Tagen!", , " GEBURTSTAGS-INFO..." End If End If End Sub

Private Sub GEBURTSTAGS_INFO() Dim sMldg1 As String, sMldg2 As String, lR As Long, iDiff As Integer Const iNn As Integer = 3 ' Spalte C - Nachnamen Const iVn As Integer = 5 ' Spalte E - Vornamen Const iG As Integer = 8 ' Spalte H - Geburtsdatum Beep sMldg1 = "Geburtstage heute:" & vbLf lR = 4 Do Until IsEmpty(Cells(lR, iVn)) iDiff = DateSerial(Year(Date), Month(Cells(lR, iG)), Day(Cells(lR, iG))) - Date If iDiff < 0 Then _ iDiff = DateSerial(1 + Year(Date), Month(Cells(lR, iG)), Day(Cells(lR, iG))) - Year( _ Date) Select Case iDiff Case 0 sMldg1 = sMldg1 & vbLf & Cells(lR, iG) & " - " & Cells(lR, iVn) & " " & _ Cells(lR, iNn) & " wird heute " & Year(Date) - Year(Cells(lR, iG)) & _ " Jahre alt!" Case 1 To 10 sMldg2 = sMldg2 & vbLf & Cells(lR, iG) & " - " & Cells(lR, iVn) & " " & _ Cells(lR, iNn) & " wird in " & " " & Format(iDiff, "00") & " Tag(en) " & " " & _ Year(Date) - Year(Cells(lR, iG)) & " Jahre alt!" End Select lR = lR + 1 Loop If sMldg1 = "Geburtstage:" & vbLf Then sMldg1 = "Heute kein Geburtstag!" If MsgBox(sMldg1, vbOKCancel, " GEBURTSTAGS-INFO...") = vbOK Then If sMldg2 <> "" Then MsgBox "Geburtstage in den nächsten 10 Tagen:" & vbLf & sMldg2, , " GEBURTSTAGS-INFO.." _ Else MsgBox "Keine Geburtstage in den nächsten 10 Tagen!", , " GEBURTSTAGS-INFO..." End If End If End Sub

Beliebteste Forumthreads (12 Monate)

Geburtstag in Messagebox anzeigen...

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread