Gruppen
- Top Gruppen
- Betriebsysteme
- Windows classik
- Linux
- BS-Sonstige
- Software
- Datenbanken
- Bildbearbeitung
- Audio/mp3/Video
- Security/Viren
- SW-Sonstige
- Hardware
- Mainboard/CPU
- Grafikkarten
- Peripherie
- Laptop/Notebook
- HW-Sonstiges
- Netzwerk
- Telefon,ISDN,Modem
- W-Lan
- NW-Sonstiges
- Programmierung
- PHP,ASP,Perl...
- Java,C++...
- Webseiten/HTML
- Sonstiges
- PC-Sonstiges
- Plauderecke
- SN Intern
- Test
/ Forum / Tabellenkalkulation
Tabellenkalkulation
Fragevon fedjo vom 10.07.2020, 11:12 Options
VBA Geburtstagsliste
Hallo Excelexperten,
ich habe einen Code für eine Geburtstagsliste gefunden,
wie muss der Code verändert werden, damit er auch einen Tag nach dem Geburtstag noch mit angezeigt wird.
Ich hoffe ihr könnt mir weiterhelfen.
Gruß
fedjo
Option Explicit
Sub Geburtstag()
Dim intgeb As Integer
Dim Loletzte As Long
Dim MsgText As String
Dim intalter As Integer
Loletzte = IIf(IsEmpty(Range("A65536")), Range("A65536").End(xlUp).Row, 65536)
For intgeb = 2 To Loletzte
intalter = (DateSerial(Year(Date), Month(Date), Day(Date)) - DateSerial(Year(Cells(intgeb, 1)), Month(Cells(intgeb, 1)), _
Day(Cells(intgeb, 1)))) / 365.25
If DateSerial(Year(Date), Month(Cells(intgeb, 1)), Day(Cells(intgeb, 1))) >= DateSerial(Year(Date), Month(Date), _
Day(Date)) And DateSerial(Year(Date), Month(Cells(intgeb, 1)), Day(Cells(intgeb, 1))) <= DateSerial(Year(Date), _
Month(Date), Day(Date) + 0) Or DateSerial(Year(Date) + 1, Month(Cells(intgeb, 1)), Day(Cells(intgeb, 1))) _
<= DateSerial(Year(Date), Month(Date), Day(Date) + 0) Then
MsgText = MsgText & vbLf & vbLf & Cells(intgeb, 1 + 2) & " " & Cells(intgeb, 1 + 1) _
& " " & "wird " & intalter & " Jahre alt"
End If
Next intgeb
If Len(MsgText) > 0 Then
MsgBox Right(MsgText, Len(MsgText) - 2), , "Geburtstag haben heute"
Else
MsgBox "heute hat keiner Geburtstag", , "Geburtstag"
End If
End Sub
ich habe einen Code für eine Geburtstagsliste gefunden,
wie muss der Code verändert werden, damit er auch einen Tag nach dem Geburtstag noch mit angezeigt wird.
Ich hoffe ihr könnt mir weiterhelfen.
Gruß
fedjo
Option Explicit
Sub Geburtstag()
Dim intgeb As Integer
Dim Loletzte As Long
Dim MsgText As String
Dim intalter As Integer
Loletzte = IIf(IsEmpty(Range("A65536")), Range("A65536").End(xlUp).Row, 65536)
For intgeb = 2 To Loletzte
intalter = (DateSerial(Year(Date), Month(Date), Day(Date)) - DateSerial(Year(Cells(intgeb, 1)), Month(Cells(intgeb, 1)), _
Day(Cells(intgeb, 1)))) / 365.25
If DateSerial(Year(Date), Month(Cells(intgeb, 1)), Day(Cells(intgeb, 1))) >= DateSerial(Year(Date), Month(Date), _
Day(Date)) And DateSerial(Year(Date), Month(Cells(intgeb, 1)), Day(Cells(intgeb, 1))) <= DateSerial(Year(Date), _
Month(Date), Day(Date) + 0) Or DateSerial(Year(Date) + 1, Month(Cells(intgeb, 1)), Day(Cells(intgeb, 1))) _
<= DateSerial(Year(Date), Month(Date), Day(Date) + 0) Then
MsgText = MsgText & vbLf & vbLf & Cells(intgeb, 1 + 2) & " " & Cells(intgeb, 1 + 1) _
& " " & "wird " & intalter & " Jahre alt"
End If
Next intgeb
If Len(MsgText) > 0 Then
MsgBox Right(MsgText, Len(MsgText) - 2), , "Geburtstag haben heute"
Else
MsgBox "heute hat keiner Geburtstag", , "Geburtstag"
End If
End Sub
Antwort 1 von Kauz vom 10.07.2020, 23:26 Options
Hallo Fedjo...
bin mir nicht ganz sicher, ob es tadellos funzt...
trotzdem hier ein geänderter code:
Probier's aus...
Gruß
Andreas
bin mir nicht ganz sicher, ob es tadellos funzt...
trotzdem hier ein geänderter code:
Option Explicit
Dim intgeb As Integer
Dim Loletzte As Long
Dim MsgText As String
Dim intalter As Integer
Sub Geburtstag()
Loletzte = IIf(IsEmpty(Range("A65536")), Range("A65536").End(xlUp).Row, 65536)
For intgeb = 2 To Loletzte
intalter = (DateSerial(Year(Date), Month(Date), Day(Date)) - DateSerial(Year(Cells(intgeb, 1)), Month(Cells(intgeb, 1)), Day(Cells(intgeb, 1)))) / 365.25
If DateSerial(Year(Date), Month(Cells(intgeb, 1)), Day(Cells(intgeb, 1))) >= DateSerial(Year(Date), Month(Date), Day(Date)) _
And DateSerial(Year(Date), Month(Cells(intgeb, 1)), Day(Cells(intgeb, 1))) <= DateSerial(Year(Date), Month(Date), Day(Date) + 0) _
Or DateSerial(Year(Date) + 1, Month(Cells(intgeb, 1)), Day(Cells(intgeb, 1))) <= DateSerial(Year(Date), Month(Date), Day(Date) + 0) Then
MsgText = MsgText & vbLf & vbLf & Cells(intgeb, 1 + 2) & " " & Cells(intgeb, 1 + 1) & " " & "wird " & intalter & " Jahre alt"
ElseIf DateSerial(Year(Date), Month(Cells(intgeb, 1)), Day(Cells(intgeb, 1))) + 1 >= DateSerial(Year(Date), Month(Date), Day(Date)) _
And DateSerial(Year(Date), Month(Cells(intgeb, 1)), Day(Cells(intgeb, 1))) <= DateSerial(Year(Date), Month(Date), Day(Date) + 0) _
Or DateSerial(Year(Date) + 1, Month(Cells(intgeb, 1)), Day(Cells(intgeb, 1))) <= DateSerial(Year(Date), Month(Date), Day(Date) + 0) Then
MsgText = MsgText & vbLf & vbLf & Cells(intgeb, 1 + 2) & " " & Cells(intgeb, 1 + 1) & " " & "ist gestern " & intalter & " Jahre alt geworden"
End If
Next intgeb
If Len(MsgText) > 0 Then
MsgBox Right(MsgText, Len(MsgText) - 2), , "Geburtstag haben heute"
Else
MsgBox "heute hat keiner Geburtstag", , "Geburtstag"
End If
End SubProbier's aus...
Gruß
Andreas
Antwort 2 von fedjo vom 11.07.2020, 14:30 Options
Hallo Andreas,
der Code funktioniert einfach perfekt.
Danke für deine Hilfe.
Gruß
fedjo
der Code funktioniert einfach perfekt.
Danke für deine Hilfe.
Gruß
fedjo
Ähnliche Themen
Handbuch zur Einführung in die VBA Programmierung in EXCEL
pvp 29.04.2007 - 357 Hits - 2 Antworten
VBA Skript für Farbumstellung an Powerpointfolien
IDone 11.01.2008 - 28 Hits -
mehre Excel Arbeitsblaetter in PowerPoint via VBA ansprechen
sammille 12.03.2008 - 100 Hits -
Hinweis
Diese Frage ist schon etwas älter, Sie können daher nicht mehr auf sie antworten. Sollte Ihre Frage noch nicht gelöst sein, stellen Sie einfach eine neue Frage im Forum..
Neue Einträge
