VBA - aktuelle Geburtstage anzeigen
05.07.2015 14:34:36
WalterK
den Code habe ich hier gefunden, er zeigt beim Öffnen der Datei die heutigen Geburtstage an. Läuft prima.
Ich hätte gern, dass in der MSG-Box bei der Anzeige des Alters z.B. (50) rechts daneben das Wort "Runder Geburtstag" steht, wenn die Zahl durch 10 (ohne Rest) teilbar ist.
Option Explicit
Private Sub Workbook_Open()
Dim rng As Range
Dim strMsg As String
On Error Resume Next
With Sheets("Mitglieder")
For Each rng In .Range("E2:E" & Application.Max(2, .Cells(.Rows.Count, 5).End(xlUp).Row))
If DateSerial(Year(Date), Month(rng), Day(rng)) = Date Then
strMsg = strMsg & Left(.Cells(rng.Row, 3).Text & " " & .Cells(rng.Row, 4).Text & String( _
35, " "), 35) & vbTab & "(" & Year(Date) - Year(rng) & ")" & vbLf
End If
Next
End With
If Len(strMsg) Then
strMsg = "Geburtstage am " & Format(Date, "dddd, dd.MM.yyyy") & vbLf & vbLf & strMsg
MsgBox strMsg
End If
On Error GoTo 0
End Sub