Public Function DiffDate(Data1 As String, Data2 As String) As String
' Questa funzione calcola la differenza tra due date (Data1 - Data2)
' esprimendo il risultato in anni, mesi e giorni.
' Le date devono essere inserite in formato testo.
' In realtà funziona anche inserendo le date in formato data, ma
' possono crearsi errori dovuti all'interpretazione delle stesse.
' Esempio: #18/02/1999# = "18/02/1999", ma #08/02/1999# = "02/08/1999"
On Error GoTo Errore_Diffdate
Dim anni, mesi, giorni, gnm
' Vengono calcolate le differenze per anni, mesi e giorni
anni = Year(Data1) - Year(Data2)
mesi = Month(Data1) - Month(Data2)
giorni = Day(Data1) - Day(Data2)
' Esegue il controllo per gli anni bisestili
If Year(Data2) \ 4 = Year(Data2) / 4 And Month(Data2) = 2 Then
gnm = GiorniNelMese(Month(Data2)) + 1
Else
gnm = GiorniNelMese(Month(Data2))
End If
' Vengono apportate le correzioni di range
If giorni < 0 Then mesi = mesi - 1: giorni = gnm + giorni
If giorni > gnm Then mesi = mesi + 1: giorni = giorni - gnm
If mesi < 0 Then anni = anni - 1: mesi = 12 + mesi
If mesi > 12 Then anni = anni + 1: mesi = mesi - 12
' Visualizza il risultato
If anni < 0 Then
DiffDate = "Date invertite"
Else
DiffDate = "a=" & anni & " m=" & mesi & " g=" & giorni
End If
Exit_Diffdate:
Exit Function
Errore_Diffdate:
Select Case Err
Case 13: DiffDate = "Data errata o non esistente"
Case 94: DiffDate = "Inserire una data"
Case Else: DiffDate = "Errore non previsto"
End Select
Resume Exit_Diffdate
End Function
Function GiorniNelMese(Mese)
' Calcola quanti giorni ha il mese
' Questa funzione non controlla gli anni bisestili
Select Case Mese
Case 1, 3, 5, 7, 8, 10, 12: GiorniNelMese = 31
Case 2: GiorniNelMese = 28
Case Else: GiorniNelMese = 30
End Select
End Function
|