Une nouvelle notion du temps écoulé.
J'ai relevé une fonction VBA écrite par l'équipe de développement Access (Clint Covington) qui apporte une vision nouvelle sur le temps écoulé et sur le temps futur qu'il reste à attendre. Selon que la période est de plus en plus courte, le temps écoulé est de plus en plus précis alors que lorsque la période est de plus en plus longue le temps écoulé est de plus en plus général. Ne dit-on pas, il y a plus de deux ans alors que le temps écoulé est de 2 ans, 30 jours, 15 heures et 12 minutes. On dit aussi plus de deux semaines pour un évènement qui s'est déroulé il y a 2 semaines, 2 jours, 5 heures.
En tenant compte des us et coutumes français, on va traiter le temps écoulé de 1 à 4 semaines, de 1 à 6 jours, l'année dernière, dans plus d'un an, etc...
Cette fonction va donc calculer, à partir d'une date/heure qui lui est communiquée, le temp écoulé ou le temps à s'écouler par rapport à l'heure actuelle.
Exemple de calculs:
Debug.Print JoursÉcoulés(Now() - 2)
Debug.Print JoursÉcoulés(Now() - 7)
Debug.Print JoursÉcoulés(Now() - 32)
Debug.Print JoursÉcoulés(Now() - 40)
Debug.Print JoursÉcoulés(Now() - 60)
Debug.Print JoursÉcoulés(Now() - 400)
Debug.Print JoursÉcoulés(Now() + 2)
Debug.Print JoursÉcoulés(Now() + 7)
Debug.Print JoursÉcoulés(Now() + 32)
Debug.Print JoursÉcoulés(Now() + 40)
Debug.Print JoursÉcoulés(Now() + 250)
Debug.Print JoursÉcoulés(Now() + 400)
Debug.Print JoursÉcoulés(Now())
ce qui affichera les résultats:
il y a plus de deux jours
il y a plus d'une semaine
il y a plus d'un mois
il y a plus d'un mois
il y a plus d'un mois
il y a plus d'un an
dans plus d'un jour
dans plus de six jours
dans plus d'un mois
dans plus d'un mois
dans moins d'une année
dans plus d'une année
maintenant
Il y a bien sûr la possibilité de rajouter l'unité de trois mois, six mois et d'autres, et chacun aura la possibilité et le loisir de modifier cette fonction pour l'adapter aux habitudes de chaque utilisateur.
Pour faciliter la modification du code, j'ai traduit les étiquettes en français.
Si vous utilisez cette fonction dans vos applications, n'oubliez pas d'indiquer le nom de l'auteur: Clint Covington, à qui nous devons l'écriture du code.
Code VBA à copier/coller dans un module standard:
Public Function JoursÉcoulés(DateHeureDébut As Date) As String
'*************************************************************
' By Clint Covington
'*************************************************************
' Function JoursÉcoulés(DateHeureDébut As Date) As String
' retourne le temps écoulé à l'instant à partir de la date indiquée
' dans le paramètre de la fonction, dans un string dont le contenu
' est de la forme "plus d'un jour", "plus de 3 semaines" etc...
'*************************************************************
Dim Intervalle As Double
Dim Jours As Variant
Dim DuréeAnnéeActuelle As Integer
Dim DuréeAnnéePrécédente As Integer
If IsNull(DateHeureDébut) Then
Exit Function
End If
Jours = DateHeureDébut - Now()
If AnneeBissextile() = 1 Then
DuréeAnnéeActuelle = 366
DuréeAnnéePrécédente = 365
Else
If AnneeBissextile() = 2 Then
DuréeAnnéeActuelle = 365
DuréeAnnéePrécédente = 366
Else
DuréeAnnéeActuelle = 365
DuréeAnnéePrécédente = 365
End If
End If
Select Case Jours
Case Is < -DuréeAnnéePrécédente
JoursÉcoulés = "il y a plus d'un an"
Case -DuréeAnnéePrécédente To -HeuresMois(5) + -HeuresMois(4)
JoursÉcoulés = "l'année dernière"
Case -HeuresMois(5) + -HeuresMois(4) To -HeuresMois(4)
JoursÉcoulés = "il y a plus d'un mois"
Case -HeuresMois(4) To -28
JoursÉcoulés = "il y a plus de quatre semaines"
Case -28 To -21
JoursÉcoulés = "il y a plus de trois semaines"
Case -21 To -13
JoursÉcoulés = "il y a plus de deux semaines"
Case -13 To -7
JoursÉcoulés = "il y a plus d'une semaine"
Case -7 To -6
JoursÉcoulés = "il y a plus de six jours"
Case -6 To -5
JoursÉcoulés = "il y a plus de cinq jours"
Case -5 To -4
JoursÉcoulés = "il y a plus de quatre jours"
Case -4 To -3
JoursÉcoulés = "il y a plus de trois jours"
Case -3 To -2
JoursÉcoulés = "il y a plus de deux jours"
Case -2 To -1
JoursÉcoulés = "il y a plus d'un jour"
Case -1 To 0
JoursÉcoulés = "il y a " & HeuresÉcoulés(DateHeureDébut)
Case 0 To 1
JoursÉcoulés = "dans " & HeuresÉcoulés(DateHeureDébut)
Case 1 To 2
JoursÉcoulés = "dans plus d'un jour"
Case 2 To 3
JoursÉcoulés = "dans plus de deux jours"
Case 3 To 4
JoursÉcoulés = "dans plus de trois jours"
Case 4 To 5
JoursÉcoulés = "dans plus de quatre jours"
Case 5 To 6
JoursÉcoulés = "dans plus de cinq jours"
Case 6 To 7
JoursÉcoulés = "dans plus de six jours"
Case 7 To 14
JoursÉcoulés = "dans plus d'une semaine"
Case 14 To 21
JoursÉcoulés = "dans plus de deux semaines"
Case 21 To 28
JoursÉcoulés = "dans plus de trois semaines"
Case 28 To HeuresMois(1)
JoursÉcoulés = "dans plus de quatre semaines"
Case HeuresMois(1) To HeuresMois(2) + HeuresMois(1)
JoursÉcoulés = "dans plus d'un mois"
Case HeuresMois(2) + HeuresMois(1) To HeuresMois(3) + HeuresMois(2) + HeuresMois(1)
JoursÉcoulés = "dans plus de deux mois"
Case HeuresMois(3) + HeuresMois(2) + HeuresMois(1) To DuréeAnnéeActuelle
JoursÉcoulés = "dans moins d'une année"
Case Is > DuréeAnnéeActuelle
JoursÉcoulés = "dans plus d'une année"
End Select
If JoursÉcoulés = "il y a 0" Or JoursÉcoulés = "dans 0" Then
JoursÉcoulés = "maintenant"
End If
End Function
Public Function EstceBissextile()
Dim Année As Variant
Année = DatePart("yyyy", Now())
If (Année Mod 4 = 0) And ((Année Mod 100 <> 0) Or (Année Mod 400 = 0)) Then
EstceBissextile = 29
Else
EstceBissextile = 28
End If
End Function
Public Function AnneeBissextile()
Dim Année As Variant
Année = DatePart("yyyy", Now())
If (Année Mod 4 = 0) And ((Année Mod 100 <> 0) Or (Année Mod 400 = 0)) Then
AnneeBissextile = 1
Exit Function
Else
Année = Année - 1
If (Année Mod 4 = 0) And ((Année Mod 100 <> 0) Or (Année Mod 400 = 0)) Then
AnneeBissextile = 2
Exit Function
Else:
AnneeBissextile = 3
End If
End If
End Function
Public Function HeuresMois() As Variant
Dim Mois As Variant
Dim HeuresMois1(5) As Variant
Mois = DatePart("m", Now())
Select Case Mois
Case 1 'Janvier
HeuresMois1(1) = 31 'Janvier
HeuresMois1(2) = EstceBissextile() 'Février
HeuresMois1(3) = 31 'Mars
HeuresMois1(4) = 31 'Décembre
HeuresMois1(5) = 30 'Décembre
Case 2 ' Février
HeuresMois1(1) = EstceBissextile() 'Février
HeuresMois1(2) = 31 'Mars
HeuresMois1(3) = 30 'Avril
HeuresMois1(4) = 31 'Janvier
HeuresMois1(5) = 31 'Décembre
Case 3 'Mars
HeuresMois1(1) = 31 'Mars
HeuresMois1(2) = 30 'Avril
HeuresMois1(3) = 31 'Mai
HeuresMois1(4) = EstceBissextile() ' Février
HeuresMois1(5) = 31 'Janvier
Case 4 'Avril
HeuresMois1(1) = 30 'Avril
HeuresMois1(2) = 31 'Mai
HeuresMois1(3) = 30 'Juin
HeuresMois1(4) = 31 'Mars
HeuresMois1(5) = EstceBissextile() ' Février
Case 5 'Mai
HeuresMois1(1) = 31 'Mai
HeuresMois1(2) = 30 'Juin
HeuresMois1(3) = 31 'Juillet
HeuresMois1(4) = 30 'Avril
HeuresMois1(5) = 31 'Mars
Case 6 'Juin
HeuresMois1(1) = 30 'Juin
HeuresMois1(2) = 31 'Juillet
HeuresMois1(3) = 31 'Août
HeuresMois1(4) = 31 'Mai
HeuresMois1(5) = 30 'Avril
Case 7 'Juillet
HeuresMois1(1) = 31 'Juillet
HeuresMois1(2) = 31 'Août
HeuresMois1(3) = 30 'Septembre
HeuresMois1(4) = 30 'Juin
HeuresMois1(5) = 31 'Mai
Case 8 'Août
HeuresMois1(1) = 30 'Août
HeuresMois1(2) = 31 'Septembre
HeuresMois1(3) = 31 'Octobre
HeuresMois1(4) = 31 'Juillet
HeuresMois1(5) = 30 'Juin
Case 9 'Septembre
HeuresMois1(1) = 31 'Septembre
HeuresMois1(2) = 31 'Octobre
HeuresMois1(3) = 30 'Décembre
HeuresMois1(4) = 30 'Août
HeuresMois1(5) = 31 'Juillet
Case 10 'Octobre
HeuresMois1(1) = 31 'Octobre
HeuresMois1(2) = 30 'Décembre
HeuresMois1(3) = 31 'Décembre
HeuresMois1(4) = 31 'Septembre
HeuresMois1(5) = 30 'Août
Case 11 'Novembre
HeuresMois1(1) = 30 'Décembre
HeuresMois1(2) = 31 'Décembre
HeuresMois1(3) = 31 'Janvier
HeuresMois1(4) = 31 'Octobre
HeuresMois1(5) = 31 'Septembre
Case 12 'Décembre
HeuresMois1(1) = 31 'Décembre
HeuresMois1(2) = 31 'Janvier
HeuresMois1(3) = EstceBissextile() 'Février
HeuresMois1(4) = 30 'Décembre
HeuresMois1(5) = 31 'Octobre
End Select
HeuresMois = HeuresMois1
End Function
Public Function HeuresÉcoulés(DateHeureDébut As Date) As String
'*************************************************************
' La fonction HeuresÉcoulés(DateHeureDébut As Date) As String
' retourne le temps écoulé entre la date de début et l'heure actuelle
' sous la forme "20 heures, 30 minutes".
'*************************************************************
Dim Intervalle As Double
Dim str As String
Dim Jours As Variant
Dim Heures As String
Dim Minutes As String
Dim Secondes As String
If IsNull(DateHeureDébut) Then
Exit Function
End If
Intervalle = Now() - DateHeureDébut
Heures = Format(Intervalle, "h")
Minutes = Format(Intervalle, "n")
' heures part of the string
str = str & IIf(Heures = "0", "", _
IIf(Heures = "1", Heures & " heure", Heures & " heures"))
str = str & IIf(Heures = "0", "", IIf(Minutes <> "0", ", ", " "))
' Minutes part of the string
str = str & IIf(Minutes = "0", "", _
IIf(Minutes = "1", Minutes & " minute", Minutes & " minutes"))
HeuresÉcoulés = IIf(str = "", "0", str)
End Function