Modules |
5.15 Calcolo esatto dell'età in anni, mesi, giorni |
Mauro Lisi |
(D) Come calcolare l'età esatta di una persona nel formato: Anni, Mesi, Giorni. (R) La seguente funzione restituisce una stringa indicante l'età di una persone in formato anni, mesi, giorni. Si ritiene che funzioni con qualunque versione di Access. Public Function eta(nascita As Date, Optional DataCorrente As Variant) As String 'Se non metti la data corrente prende in automatico la data odierna If IsMissing(DataCorrente) Then DataCorrente = Date Dim Anni As Integer Dim Mesi As Integer Dim Giorni As Integer 'Calcolo gli anni Anni = Year(DataCorrente) - Year(nascita) If DateSerial(Year(DataCorrente), Month(nascita), Day(nascita)) > DataCorrente Then Anni = Anni - 1 End If 'Calcolo i mesi If Month(nascita) = Month(DataCorrente) Then If Day(nascita) < Day(DataCorrente) Then Mesi = 0 End If If Day(nascita) > Day(DataCorrente) Then Mesi = 11 End If End If If Month(nascita) > Month(DataCorrente) Then Mesi = 12 - Month(nascita) + Month(DataCorrente) If Day(nascita) > Day(DataCorrente) Then Mesi = Mesi - 1 End If End If If Month(nascita) < Month(DataCorrente) Then Mesi = Month(DataCorrente) - Month(nascita) If Day(nascita) > Day(DataCorrente) Then Mesi = Mesi - 1 End If End If 'Calcolo i giorni If Month(nascita) < Month(DataCorrente) Then If Day(nascita) > Day(DataCorrente) Then Giorni = Day(DateSerial(Year(DataCorrente), Month(nascita) + 1, 0)) - Day(nascita) + Day(DataCorrente) End If If Day(nascita) < Day(DataCorrente) Then Giorni = Day(DataCorrente) - Day(nascita) End If End If If Month(nascita) = Month(DataCorrente) Then If Day(nascita) > Day(DataCorrente) Then Giorni = Day(DateSerial(Year(DataCorrente), Month(nascita), 0)) - Day(nascita) + Day(DataCorrente) End If If Day(nascita) < Day(DataCorrente) Then Giorni = Day(DataCorrente) - Day(nascita) End If End If If Month(nascita) > Month(DataCorrente) Then If Day(nascita) > Day(DataCorrente) Then Giorni = Day(DateSerial(Year(DataCorrente), Month(nascita) + 1, 0)) - Day(nascita) + Day(DataCorrente) End If If Day(nascita) < Day(DataCorrente) Then Giorni = Day(DataCorrente) - Day(nascita) End If End If eta = "Età : Anni=" & Anni & " Mesi=" & Mesi & " Giorni=" & Giorni End Function Download: |