Geburtstag in Messagebox anzeigen...

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Bild

Betrifft: Geburtstag in Messagebox anzeigen...
von: Ina
Geschrieben am: 26.10.2015 18:55:14

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

Bild

Betrifft: AW: Geburtstag in Messagebox anzeigen...
von: Hajo_Zi
Geschrieben am: 26.10.2015 19:16:56
Hallo Ina,
vielleicht ein Ansatz.
http://excel-inn.de/dateien/vba_beispiele/geburtstage_heute_userform_mit_bild.zip


Bild

Betrifft: AW: Geburtstag in Messagebox anzeigen...
von: Ina
Geschrieben am: 26.10.2015 19:31:49
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

Bild

Betrifft: AW: Geburtstag in Messagebox anzeigen...
von: Hajo_Zi
Geschrieben am: 26.10.2015 19:42:05
Hallo Ina,
ich hatte das falsche Beispiel verlinkt.
http://excel-inn.de/dateien/vba_beispiele/geburtstag_heute_ermitteln_zellen_einfaerben.zip
Gruß Hajo

Bild

Betrifft: AW: Geburtstag in Messagebox anzeigen...
von: Ina
Geschrieben am: 26.10.2015 19:55:38
Hallo Hajo,
das ist schon sehr nah am gewünschten Ergebnis.
Aber was habe ich in diesem Beispiel falsch gemacht?

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

Bild

Betrifft: probier mal... Gruß
von: robert
Geschrieben am: 26.10.2015 20:04:16


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


Bild

Betrifft: AW: probier mal... Gruß
von: Ina
Geschrieben am: 26.10.2015 20:27:51
Hallo Robert,
danke für deinen Beitrag.
Beim Ausführen kommt es zu einer Fehlermeldung (Laufzeitfehler '6': Überlauf) in dieser Zeile:
iDiff = DateSerial(1 + Year(Date), Month(Cells(lR, iG)), Day(Cells(lR, iG))) - Year( _
Date)
LG Ina

Bild

Betrifft: AW: probier mal... bei mir nicht..Gruß
von: robert
Geschrieben am: 26.10.2015 20:43:05
https://www.herber.de/bbs/user/101046.xlsm

Bild

Betrifft: AW: probier mal... habe probiert ;-)
von: Ina
Geschrieben am: 26.10.2015 21:04:47
Stimmt - funktioniert!
Mein Fehler! Ich hatte den Code einfach kopiert und "Option Explicit" vergessen!
Vielen Dank!
LG Ina

Bild

Betrifft: AW: probier mal... Gruß
von: Ina
Geschrieben am: 26.10.2015 21:50:35
Hallo Robert,
danke für deinen Beitrag.
Beim Ausführen kommt es nun doch zu der Fehlermeldung (Laufzeitfehler '6': Überlauf) in dieser Zeile, wenn der Monat das ersten Geburtsdatums NICHT in den Monat fällt:
iDiff = DateSerial(1 + Year(Date), Month(Cells(lR, iG)), Day(Cells(lR, iG))) - Year( _
Date)
https://www.herber.de/bbs/user/101050.xlsm
LG Ina

Bild

Betrifft: Dim iDiff As Long
von: Matthias L
Geschrieben am: 26.10.2015 23:15:32
Hallo Ina

Dim sMldg1 As String, sMldg2 As String, lR As Long, iDiff As Long
Gruß Matthias

Bild

Betrifft: AW: Dim iDiff As Long DANKE Matthias!
von: Ina
Geschrieben am: 26.10.2015 23:44:57
Hallo Matthias,
danke für deine Hilfe...
Super! Genau damit ist das Problem behoben!
LG Ina

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Geburtstag in Messagebox anzeigen..."