Une nouvelle notion du temps écoulé.

Publié le par Raymond


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

 

Publié dans Nouvelles fonctions

Commenter cet article