Modules

5.60 Differenza tra due oggetti di tipo Data/ora in anni, mesi, giorni, ore, minuto e secondi
  Carlo Costarella, Roberto, UBI
Qui di seguito è mostrato il codice VBA di una funzione che calcola il numero di anni, mesi, giorni, ore, minuti e secondi esistenti tra due oggetti di tipo Data/ora.
Public Function Diff2Dates(Interval As String, Date1 As Date, Date2 As Date, _
Optional ShowZero As Boolean = False) As Variant

'Descrizione: Questa funzione calcola il numero di anni,
'             mesi, giorni, ore, minuti e secondi esistenti tra
'             due oggetti di tipo Data/ora
'
'Inputs:    Interval:   Stringa che indica il formato del risultato
'           Date1:      Prima variabile di tipo Data/ora (inizio periodo)
'           Date2:      Seconda variabile di tipo Data/ora (fine periodo)
'           ShowZero:   Variabile booleana che indica se nel risultato
'                           vanno mostrati i valori uguali a zero
'
'Outputs:   In caso di errore: viene restituito un risultato Null
'           In caso di non errore: Variant contiene il numerodi anni,
'               mesi, giorni, ore, minuti e secondi compresi tra
'               le due date, A seconta di quanto scelto con la stringa
'               Interval.
'           Se Date1 è maggiore di Date2, verrà restituito un
'               risultato con valore negativo.
'           La funzione compensa per ogni tipo di intervallo non
'               richiesto. Per esempio, se Interval contiene "m", ma
'               non "y", la funzione somma il valore degli anni
'               moltiplicato 12 ai mesi.
'           Se ShowZero è True, e un elemento di output è zero, esso viene
'               comunque mostrato. Invece, se ShowZero é False o è
'               omesso, gli elementi di valori zero non vengono mostrati.
'               Per esempio, con ShowZero = False e Interval = "ym",
'               elementi = rispettivamente a 0 & 1, la stringa dell'aoutput
'               sarà "1 mese" e non "0 anni 1 mese".
'
'************** Esempi ***************
' Print Diff2Dates("y", #6/1/1998#, #6/26/2002#)
' Print Diff2Dates("ymd", #6/1/1998#, #6/26/2002#)
' Print Diff2Dates("ymd", #6/1/1998#, #6/26/2002#, True)
' Print Diff2Dates("d", #6/1/1998#, #6/26/2002#)
' Print Diff2Dates("h", #1/25/2002 1:23:01 AM#, #1/26/2002 8:10:34 PM#)
' Print Diff2Dates("hns", #1/25/2002 1:23:01 AM#, #1/26/2002 8:10:34 PM#)
' Print Diff2Dates("dhns", #1/25/2002 1:23:01 AM#, #1/26/2002 8:10:34 PM#)
' Print Diff2Dates("ymd", #12/31/1999#, #1/1/2000#)
' Print Diff2Dates("ymd", #1/1/2000#, #12/31/1999#)
' Print Diff2Dates("ymd", #1/1/2000#, #1/2/2000#)
'***************** Fine esempi **************

On Error GoTo Err_Diff2Dates
   Dim booCalcYears As Boolean
   Dim booCalcMonths As Boolean
   Dim booCalcDays As Boolean
   Dim booCalcHours As Boolean
   Dim booCalcMinutes As Boolean
   Dim booCalcSeconds As Boolean
   Dim booSwapped As Boolean
   Dim dtTemp As Date
   Dim intCounter As Integer
   Dim lngDiffYears As Long
   Dim lngDiffMonths As Long
   Dim lngDiffDays As Long
   Dim lngDiffHours As Long
   Dim lngDiffMinutes As Long
   Dim lngDiffSeconds As Long
   Dim varTemp As Variant
   Const INTERVALS As String = "dmyhns"
'Controlla che Interval contenga solo valori validi
   Interval = LCase$(Interval)
   For intCounter = 1 To Len(Interval)
      If InStr(1, INTERVALS, Mid$(Interval, intCounter, 1)) = 0 Then
         Exit Function
      End If
   Next intCounter
'Verifica che si stanno usando due date valide
   If Not (IsDate(Date1)) Then Exit Function
   If Not (IsDate(Date2)) Then Exit Function
'Se necessario, inverti le date, per essere
'sicuro che Date1 sia minore di Date2.
   If Date1 > Date2 Then
      dtTemp = Date1
      Date1 = Date2
      Date2 = dtTemp
      booSwapped = True
   End If
   Diff2Dates = Null
   varTemp = Null
'Che intervallo è stato fornito
   booCalcYears = (InStr(1, Interval, "y") > 0)
   booCalcMonths = (InStr(1, Interval, "m") > 0)
   booCalcDays = (InStr(1, Interval, "d") > 0)
   booCalcHours = (InStr(1, Interval, "h") > 0)
   booCalcMinutes = (InStr(1, Interval, "n") > 0)
   booCalcSeconds = (InStr(1, Interval, "s") > 0)
'Calcola le differenze comulative
   If booCalcYears Then
      lngDiffYears = Abs(DateDiff("yyyy", Date1, Date2)) - _
              IIf(Format$(Date1, "mmddhhnnss") <= Format$(Date2, "mmddhhnnss"), 0, 1)
      Date1 = DateAdd("yyyy", lngDiffYears, Date1)
   End If
   If booCalcMonths Then
      lngDiffMonths = Abs(DateDiff("m", Date1, Date2)) - _
              IIf(Format$(Date1, "ddhhnnss") <= Format$(Date2, "ddhhnnss"), 0, 1)
      Date1 = DateAdd("m", lngDiffMonths, Date1)
   End If
   If booCalcDays Then
      lngDiffDays = Abs(DateDiff("d", Date1, Date2)) - _
              IIf(Format$(Date1, "hhnnss") <= Format$(Date2, "hhnnss"), 0, 1)
      Date1 = DateAdd("d", lngDiffDays, Date1)
   End If
   If booCalcHours Then
      lngDiffHours = Abs(DateDiff("h", Date1, Date2)) - _
              IIf(Format$(Date1, "nnss") <= Format$(Date2, "nnss"), 0, 1)
      Date1 = DateAdd("h", lngDiffHours, Date1)
   End If
   If booCalcMinutes Then
      lngDiffMinutes = Abs(DateDiff("n", Date1, Date2)) - _
              IIf(Format$(Date1, "ss") <= Format$(Date2, "ss"), 0, 1)
      Date1 = DateAdd("n", lngDiffMinutes, Date1)
   End If
   If booCalcSeconds Then
      lngDiffSeconds = Abs(DateDiff("s", Date1, Date2))
      Date1 = DateAdd("s", lngDiffSeconds, Date1)
   End If
   If booCalcYears And (lngDiffYears > 0 Or ShowZero) Then
      varTemp = lngDiffYears & IIf(lngDiffYears <> 1, " anni", " anno")
   End If
   If booCalcMonths And (lngDiffMonths > 0 Or ShowZero) Then
      If booCalcMonths Then
         varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                   lngDiffMonths & IIf(lngDiffMonths <> 1, " mesi", " mese")
      End If
   End If
   If booCalcDays And (lngDiffDays > 0 Or ShowZero) Then
      If booCalcDays Then
         varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                   lngDiffDays & IIf(lngDiffDays <> 1, " giorni", " giorno")
      End If
   End If
   If booCalcHours And (lngDiffHours > 0 Or ShowZero) Then
      If booCalcHours Then
         varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                   lngDiffHours & IIf(lngDiffHours <> 1, " ore", " ora")
      End If
   End If
   If booCalcMinutes And (lngDiffMinutes > 0 Or ShowZero) Then
      If booCalcMinutes Then
         varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                   lngDiffMinutes & IIf(lngDiffMinutes <> 1, " minuti", " minuto")
      End If
   End If
   If booCalcSeconds And (lngDiffSeconds > 0 Or ShowZero) Then
      If booCalcSeconds Then
         varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                   lngDiffSeconds & IIf(lngDiffSeconds <> 1, " secondi", " secondo")
      End If
   End If
   If booSwapped Then
      varTemp = "-" & varTemp
   End If
   Diff2Dates = Trim$(varTemp)
End_Diff2Dates:
   Exit Function
Err_Diff2Dates:
   Resume End_Diff2Dates
End Function
Alcune considerazione sul funzionamento della funzione possono esere lette nei commenti posti all'interno del codice VBA di cui sopra.
Interval dovrà contenere:
- anche il carattere y se si vuole che la differenza venga fatta anche in anni
- anche il carattere m se si vuole che la differenza venga fatta anche in mesi
- anche il carattere d se si vuole che la differenza venga fatta anche in giorni
- anche il carattere h se si vuole che la differenza venga fatta anche in ore
- anche il carattere n se si vuole che la differenza venga fatta anche in minuti
- anche il carattere s se si vuole che la differenza venga fatta anche in secondi
Non è necessario indicare tutti e sei i caratteri; se ad esempio si vuole che la differenza avvenga solo in minuti, si indicherà solo il carattere n.

I due oggeti Data/ora potranno contenere solamente delle date (10/04/2005), solamente degli orari (12:20:45) oppure sia una data che un orario (10/04/2005 12:20:45).

Download:
 
  DifferenzeData_ora.zip (31Kb) MSAccess97 database


Se pensate di avere del materiale freeware interessante e volete pubblicarlo, allora leggete qui.