Excel VBA Makro Code zum Thema Datum

Geburtstag

Der folgende Code überprüft eine Tabelle, damit man sieht wer in den nächsten 14 Tagen Geburtstag hat.



A B C 1 Name Vorname Geburtstag 2 Name1 Vorname1 27.09.2003 3 Name2 Vorname2 28.09.2003 4 Name3 Vorname3 29.09.2003 5 Name4 Vorname4 30.09.2003 6 Name5 Vorname5 01.10.2003 7 Name6 Vorname6 02.10.2003 8 Name7 Vorname7 03.10.2003 9 Name8 Vorname8 04.10.2003 10 Name9 Vorname9 05.10.2003






Der Code:



Option Explicit

Sub Geburtstag()
Dim intgeb As Integer
Dim Loletzte As Long
Dim MsgText As String
Dim intalter As Integer
    Loletzte = IIf(IsEmpty(Range("c65536")), Range("c65536").End(xlUp).Row, 65536)
    For intgeb = 2 To Loletzte
        intalter = (DateSerial(Year(Date), Month(Date), Day(Date)) - DateSerial(Year(Cells(intgeb, 3)), Month(Cells(intgeb, 3)), _
        Day(Cells(intgeb, 3)))) / 365.25
        If DateSerial(Year(Date), Month(Cells(intgeb, 3)), Day(Cells(intgeb, 3))) >= DateSerial(Year(Date), Month(Date), _
            Day(Date)) And DateSerial(Year(Date), Month(Cells(intgeb, 3)), Day(Cells(intgeb, 3))) <= DateSerial(Year(Date), _
            Month(Date), Day(Date) + 14) Or DateSerial(Year(Date) + 1, Month(Cells(intgeb, 3)), Day(Cells(intgeb, 3))) _
            <= DateSerial(Year(Date), Month(Date), Day(Date) + 14) Then
            MsgText = MsgText & vbLf & vbLf & Cells(intgeb, 3 - 2) & ",   " & Cells(intgeb, 3 - 1) & "  " & Cells(intgeb, 3) _
            & "  " & "wird " & intalter & " Jahre alt"
        End If
    Next intgeb
    If Len(MsgText) > 0 Then MsgBox Right(MsgText, Len(MsgText) - 2)
End Sub






© 2008 Marcus Rose