Calcul de Durée entre deux Dates

Question

Bonjour à tous, je sollicite votre aide pour m'aider à resoudre mon problèment en matière de calcul de durée entre deux dates sous vb6. Merci d'avance. Voici donc mon Problème. Function CalculDuree(DateN As String, DateCS As String) As String If IsDate(DateN) = False Then Exit Function If IsDate(DateCS) = False Then Exit Function Dim jN1, jC1, mN1, mC1, aN1, aC1 As Integer Dim Jage, Mage, Aage As Integer Dim Jdif As Integer jN1 = Day(DateN) jC1 = Day(DateCS) mN1 = Month(DateN) mC1 = Month(DateCS) aN1 = Year(DateN) aC1 = Year(DateCS) If aC1 < aN1 Then Exit Function If aC1 = aN1 And mC1 < mN1 Then Exit Function If aC1 aN1 And mC1 mN1 And jC1 < jN1 Then Exit Function If aC1 aN1 And mC1 mN1 And jC1 = jN1 Then Mage = 0 Jage = 0 Aage = 0 GoTo caline1 End If ' Permet de savoir le nombre de jours du mois (fevrier inclus) Dim sdt1 As Date Dim sdt2 As Date sdt1 = DateValue("1" & "/" & mN1 & "/" & aN1) sdt2 = DateValue("1" & "/" & mN1 + 1 & "/" & aN1) Jdif = DateDiff("d", sdt1, sdt2) If jC1 < jN1 Then If mC1 > mN1 Then Mage = (mC1 - 1) - mN1 Jage = (jC1 + Jdif) - jN1 Aage = aC1 - aN1 GoTo caline1 End If If mC1 = mN1 Then Aage = aC1 - 1 - aN1 Mage = (mC1 + 11) - mN1 Jage = (jC1 + Jdif) - jN1 GoTo caline1 End If If mC1 < mN1 Then Mage = (mC1 + 11) - mN1 Jage = (jC1 + Jdif) - jN1 Aage = aC1 - 1 - aN1 GoTo caline1 End If End If If jC1 >= jN1 Then If mC1 > mN1 Then Jage = jC1 - jN1 Mage = mC1 - mN1 Aage = aC1 - aN1 GoTo caline1 End If If mC1 = mN1 Then Jage = jC1 - jN1 Mage = mC1 - mN1 Aage = aC1 - aN1 GoTo caline1 End If If mC1 < mN1 Then Jage = jC1 - jN1 Mage = (mC1 + 12) - mN1 Aage = aC1 - 1 - aN1 GoTo caline1 End If End If caline1: CalculDuree = Aage & "A " & Mage & "M " & Jage & "J" End Function UTILISATION: Private Sub DateCible_Change() On Error Resume Next TxtStat(5).Text = DateCible.Text Dim mDateSce As String Dim mDatePro As String Dim mDateCbl As String mDateSce = TxtStat(6).Text mDatePro = TxtStat(7).Text mDateCbl = TxtStat(5).Text TxtStat(8).Text = CalculDuree(mDateSce, mDateCbl) TxtStat(9).Text = CalculDuree(mDatePro, mDateCbl) End Sub Si je prends DateCible = 31/12/2010 mDateSce = 01/06/1986 mDatePro = 01/10/2009 Résultat: TxtStat(8).Text = 23A 6M 30J TxtStat(9).Text = 1A 2M 30J Alors que logiquement j'aurais du avoir : TxtStat(8).Text = 23A 7M 0J TxtStat(9).Text = 1A 3M 0J Aidez s'il vous plait. Merci à tous

cs_Jack · Answer

Salut
Pas eu le courage de détailler ton code.
Juste un conseil : Intéresse-toi aux fonctions DateDiff et DateAdd
Tu verras que ce sera beaucoup plus sûr et plus simple.

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)

cs_Jack · Answer

PS : Tape aussi "calculer age" dans la recherche parmi les codes en excluant .Net : tu trouveras des exemples

cs_Jack · Answer

Pour le principe :
- tu calcules le nombre d'années entières entre tes deux dates --> mémoire Années
- tu ajoutes ces années entières à la vieille date
- tu calcules le nombre de mois entiers entre tes deux dates --> mémoire Mois
- tu ajoutes ces mois entiers à la vieille date
- tu calcules le nombre de jour entiers entre tes deux dates --> mémoire Jours

Renfield · Answer

algo de base...

Dim nbJours As Long
Dim nbMois As Long
Dim nbAnnees As Long
    nbJours = (#3/13/2010# - #12/31/1983#)
    nbAnnees = nbJours / 365.25
    nbJours = nbJours - nbAnnees * 365.25
    nbMois = nbJours / 30
    nbJours = nbJours - nbMois * 30
    MsgBox nbAnnees & " A - " & nbMois & " M - " & nbJours & " J"


Renfield - Admin CodeS-SourceS - MVP Visual Basic

cs_warzet · Answer

Je voudrais vous remercier tous pour l'aide que vous avez bien voulu m'apporter. J'y suis arrivé et je publie ici le résultat qui pourrait aider d'autres personnes qui se retrouveraient dans la même situation que moi.
La fonction devient donc:

Public Function AgeDuree(D1 As Date, D2 As Date) As String

Dim Annees As Long, Mois As Long, Jours As Long, DecalMois As Long

On Error GoTo Erreur:
    If D1 > D2 Then
        AgeDuree = "Dates invalides"
        Exit Function
    End If
    
DecalMois = IIf(Day(D2) < Day(D1), 1, 0)

Annees = Year(D2) - Year(D1) - Switch(Month(D2) < Month(D1), 1, _
    Month(D2) = Month(D1), DecalMois, True, 0)
    
Mois = (Month(D2) - Month(D1) - DecalMois + 12) Mod 12

Jours = Day(D2) - Day(D1) + DecalMois * Day(DateSerial(Year(D2), Month(D2), 1) - 1)
   
If Jours = 30 Then
    Jours = Jours - 30
    Mois = Mois + 1
End If

If Jours 30 And Mois 11 Then
    Jours = Jours - 30
    Mois = Mois + 1
        If Mois + 1 = 12 Then
            Mois = Mois - 12
            Annees = Annees + 1
        End If
End If
 
If Mois = 12 Then
    Mois = Mois - 12
    Annees = Annees + 1
End If

AgeDuree = Trim(Annees & "A " & Mois & "M " & Jours & "J")
    Exit Function
    
Erreur:
    
AgeDuree = "Calcul Impossible"

End Function

Merci encore à tous et particulièrement à Renfield et à Jack. Bonne journée à vous.

Renfield · Answer

plutot complexe...

If Jours 30 And Mois 11 Then 
Jours = Jours - 30 
Mois = Mois + 1 
If Mois + 1 = 12 Then 
Mois = Mois - 12 
Annees = Annees + 1 
End If 
End If 

étrange, non ?

pour entrer dans le corps principal, il faut Mois = 11
tu y fait Mois = Mois +1 
donc Mois = 12
du coup, le test If Mois + 1 = 12 
ne sera jamais utilisé ....

Renfield - Admin CodeS-SourceS - MVP Visual Basic	& Spécialiste des RegExp

Calcul de Durée entre deux Dates

6 réponses

Votre réponse

Discussions similaires