Folgende Prozedur berechnet das Alter und zwar korrekt je nachdem ob man vor oder nach dem Stichtag Geburtstag hat, wird kein Stichtag eingegeben, wird das aktulle Datum verwendet, wird kein Geburtstag eingegeben wird die Funktion ohne Auswirkung beendet. Das Ganze bezieht sich auf eine Verwendung in einem Formular (also einer reinen Bildschirmanzeige), natürlich kann man das auch in einem Report ausführen, dann allerdings muß man diese Funktionen und alles drumherum bei der Aktivität ?onPrint? einbauen.
Public Function funcAltersberechnung(dtGeburtstag As Date, dtStichtag As Date) As Integer
If IsNull(dtGeburtstag) Then
funcAltersberechnung = Null
Exit Function
End If
If IsNull(dtStichtag) Then dtStichtag = Date
If DateSerial(Year(dtStichtag), Month(dtGeburtstag), Day(dtGeburtstag)) > dtStichtag Then
funcAltersberechnung = DateDiff(yyyy, dtGeburtstag, dtStichtag) - 1
Else
funcAltersberechnung = DateDiff(yyyy, dtGeburtstag, dtStichtag)
End If
End Function
Man benötigt also zwei Felder (Geburtstag und Stichtag) mit dem Format Date (tt.mm.yyyy).
Diese übergibt man dieser Funktion [Altersfeld = funcAltersberechnung(MeinGeburtstagsfeld, MeinStichtagsfeld)] und kann dann in einem dritten Feld das Datum anzeigen (hier Me![AnzAlter]).
In der Eigenschaft des Stichtagsfeldes ?beim Verlassen? wird also folgende Ereignisprozedur untergebracht:
Private Sub MeinStichtagsfeld_Exit(Cancel As Integer)
On Error GoTo Err_MeinStichtagsfeldExit
Me![AnzAlter] = funcAltersberechnung(Me![MeinGeburtstagsfeld], Me![MeinStichtagsfeld])
If Me![AnzAlter] > 60 Then
Me![AnzAlter].FontName = Arial
Me![AnzAlter].FontSize = 14
Me![AnzAlter].FontBold = True
Else
Me![AnzAlter].FontName = Arial
Me![AnzAlter].FontSize = 10
Me![AnzAlter].FontBold = False
End If
Exit_ MeinStichtagsfeldExit:
Exit Sub
Err_ MeinStichtagsfeldExit:
MsgBox Fehler
GoTo Exit_ MeinStichtagsfeldExit
End Sub
Gruß
Kurt Körner
