VB6 - Différence entre deux dates en AA MM et Jours [Résolu]

cpapy - 11 févr. 2017 à 15:52 - Dernière réponse :  cpapy
- 13 févr. 2017 à 19:21
Bonjour,

Je souhaiterais calculer la différence entre deux dates en AA MM et JOURS
exemple:
.
.....Hiers..... <----------> Aujourd'hui
15/05/2010 <----------> 11/02/2017

Aujourd'hui <---------->....Demain
11/02/2017 <----------> 05/08/2020

Je n'ai rien trouvé sur Internet. Les procédures que j'ai développées qui utilisaient "Diffdate" ne m' ont pas données le résultat que je recherchais.
.
Alors, si vous avez cette source, je vous serais très reconnaissant de me la communiquer.

Encore merci
Afficher la suite 

12 réponses

Répondre au sujet
vb95 1388 Messages postés samedi 11 janvier 2014Date d'inscriptionContributeurStatut 15 décembre 2017 Dernière intervention - 11 févr. 2017 à 17:46
0
Utile
Bonjour

Dim date1 As Date, date2 As Date

date1 = "01/01/2004"
date2 = "12/08/2005"

MsgBox "Durée en jours : " & DateDiff("d", date1, date2)
MsgBox "Durée en nombre de mois : " & DateDiff("m", date1, date2)
MsgBox "Durée en années : " & DateDiff("y", date1, date2)


Le résultat sera ou en jours ou en mois ou en années mais pas en années et jours et mois
Commenter la réponse de vb95
0
Utile
Ce n'est pas ce que je recherche.
.
Je souhaiterais calculer la différence entre deux dates en AA en MM et en JOURS

Merci pour votre réponse.
Commenter la réponse de cpapy
vb95 1388 Messages postés samedi 11 janvier 2014Date d'inscriptionContributeurStatut 15 décembre 2017 Dernière intervention - 11 févr. 2017 à 18:57
0
Utile
Bonsoir
Ce que tu voudrais si on prend cette exemple
06/08/2012
10/08/2015

la différence est de 3 ans et 4 jours
C'est plus difficile à mettre en œuvre mais c'est faisable
Je vais réfléchir à le faire en VB Net puis je te le traduirais en VB 6
Commenter la réponse de vb95
ucfoutu 18022 Messages postés lundi 7 décembre 2009Date d'inscriptionModérateurStatut 13 décembre 2017 Dernière intervention - 11 févr. 2017 à 20:22
0
Utile
1
Bonjour et un salut à VB95 :
j'ai sorti cela de mes vieux fagots :
Public Function Age1(D1 As String, D2 As String) As String
Age1 = "une date est manquante"
If D1 = "" Or D2 = "" Then Exit Function
Age1 = "La 2ème date doit nécessairement être plus grande que la 1ère !"
If DateValue(D1) > DateValue(D2) Or Not IsDate(D2) Then Exit Function
Dim toto As String, a As Integer, m As Integer, j As Integer
toto = DateValue(DateSerial(Year(D2) - Year(D1), Month(D2) - Month(D1), Day(D2) - Day(D1)))
a = Val(Format(toto, "yy"))
m = Val(Format(toto, "mm"))
j = Val(Format(toto, "dd"))
Age1 = Str(a) & " an" & IIf(a > 1, "s, ", ", ") & Str(m) & " mois et " _
& Str(j) & " jour" & IIf(j > 1, "s", "")
End Function


fonction a appeler ainsi (exemple) :
duree = Age1(date1, date2)
vb95 1388 Messages postés samedi 11 janvier 2014Date d'inscriptionContributeurStatut 15 décembre 2017 Dernière intervention - 11 févr. 2017 à 21:00
bonsoir ucfoutu
J'ai fini de manger et je tombe sur ta réponse !
Connaissant le sérieux de tes interventions je n'ai plus besoin de réfléchir : tu donnes la solution
Amitiés et salutations pour toi l
Commenter la réponse de ucfoutu
0
Utile
Bonjour Mr ucfoutu,

J'ai commencé les essais avec votre procédure et j'ai rencontré un problème avec les dates suivantes:
.
- Lorsque Date1 = "2017/07/17" et date2 = "2017/02/07" la procédure renvoie 99 ans 12 Mois 16 Jours
.
- Lorsque Date1 = "2017/02/07" et Date2 = "2017/02/07", la procédure renvoie 99 ans 11 Mois et 30 jours.
.
La procédure affiche un petit message d'erreur
- Lorsque Date = "2017/07/02" et Date2= "2017/02/02"
.
Sauf erreur de ma part, J'ai l'impression que l'anomalie provient de l'instruction:
.
toto = DateValue(DateSerial(Year(D2) - Year(D1), Month(D2) - Month(D1), Day(D2) - Day(D1)))
.
Encore merci pour votre support
Commenter la réponse de cpapy
0
Utile
Dans le 1er exemple précédent, il faut lire:
.
- Lorsque Date1 = "2017/02/07" et date2 = "2017/02/28" la procédure renvoie 99 ans 12 Mois 23 Jours
Commenter la réponse de cpapy
ucfoutu 18022 Messages postés lundi 7 décembre 2009Date d'inscriptionModérateurStatut 13 décembre 2017 Dernière intervention - 12 févr. 2017 à 20:08
0
Utile
Les dates de début et de fin, dans mon exemple, sont au format normal jj/mm/aaaa. Le résultat seul est au format x ans y mois, z jours.
Fais donc ainsi et constate :
une textbox nommée datedébut
une textbox nommée datefin
un bouton de commande Command1
et ce code :
Private Sub Command1_Click()
MsgBox Age1(date_debut, date_fin)
End Sub
Public Function Age1(D1 As String, D2 As String) As String
Age1 = "une date est manquante"
If D1 = "" Or D2 = "" Then Exit Function
Age1 = "La 2ème date doit nécessairement être plus grande que la 1ère !"
If DateValue(D1) > DateValue(D2) Or Not IsDate(D2) Then Exit Function
Dim toto As String, a As Integer, m As Integer, j As Integer
toto = DateValue(DateSerial(Year(D2) - Year(D1), Month(D2) - Month(D1), Day(D2) - Day(D1)))
a = Val(Format(toto, "yy"))
m = Val(Format(toto, "mm"))
j = Val(Format(toto, "dd"))
Age1 = Str(a) & " an" & IIf(a > 1, "s, ", ", ") & Str(m) & " mois et " _
& Str(j) & " jour" & IIf(j > 1, "s", "")
End Function

Lance --->> saisis une date de début valide au format jj/mm/aaaa et une date de fin valide au format jj/mm/aaaa et clique sur le bouton de commande.
Commenter la réponse de ucfoutu
0
Utile
Bonjour Mr ucfoutu,

Contrairement à ce que j'ai écrit plus haut, j'avais utilisé des dates sous la forme JJ/MM/AAAA. Je viens de refaire de nouveaux essais et je confirme les résultats que j'avais indiqués (à savoir --> 99 ans ..........)

La procédure ne répond pas correctement lorsque le mois et l'année de Date1 et de Date2 sont identiques. (Toujours 99 ans ..........)

Lorsque le mois et l'année sont identiques, j'ai ajouté une année à Date2 en début de procédure que j'ai retirée en sortie de procédure. Le résultat semble maintenant correct.

Merci encore pour votre support
Commenter la réponse de cpapy
0
Utile
Je crois que le problème est beaucoup plus important que je ne le pensais (principalement lorsque c'est la même année pour date1 et pour date2)
Commenter la réponse de cpapy
ucfoutu 18022 Messages postés lundi 7 décembre 2009Date d'inscriptionModérateurStatut 13 décembre 2017 Dernière intervention - 13 févr. 2017 à 18:31
0
Utile
Ouille ...
Je t'ai par mégarde envoyé la mauvaise fonction (Age1) qui se trouvait dans mon fichier en essai abandonné.
Remplace-la par la bonne (Age) qui est celle-ci
Public Function Age(D1 As String, D2 As String) As String
Dim nba As Integer, nbm As Integer, nbj As Integer
Age = "une date est manquante"
If D1 = "" Or D2 = "" Then Exit Function
Age = "La 2ème date doit nécessairement être plus grande que la 1ère !"
If DateValue(D1) > DateValue(D2) Or Not IsDate(D2) Then Exit Function
Dim LaFeinte As Long
LaFeinte = IIf(Day(D2) < Day(D1), 1, 0)
nba = Year(D2) - Year(D1) - Switch(Month(D2) < Month(D1), 1, Month(D2) = Month(D1), _
LaFeinte, True, 0)
nbm = (Month(D2) - Month(D1) - LaFeinte + 12) Mod 12
nbj = Day(D2) - Day(D1) + LaFeinte * Day(DateSerial(Year(D2), Month(D2), 1) - 1)
Age = Trim(IIf(nba > 0, nba & " an" & IIf(nba > 1, "s", "") & " ", "") & _
IIf(nbm > 0, nbm & " mois ", "") & IIf((nbj > 0) Or (nba + nbm = 0), nbj & " jour" & _
IIf(nbj > 1, "s", ""), ""))
End Function

Tout devrait aller bien.
Commenter la réponse de ucfoutu
0
Utile
Les premiers essais que je viens de faire m'ont donnés des résultats très satisfaisants.

Excellent !

Encore merci pour votre aide.

Très cordialement
Commenter la réponse de cpapy

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.