VB6 - Différence entre deux dates en AA MM et JoursRésolu

Question

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

vb95 · Answer

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

cpapy · Answer

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.

vb95 · Answer

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

ucfoutu · Answer

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)

cpapy · Answer

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

cpapy · Answer

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

ucfoutu · Answer

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.

cpapy · Answer

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

cpapy · Answer

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)

ucfoutu · Answer

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.

cpapy · Answer

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

Naoufel · Answer

Encore merci pour votre aide.

VB6 - Différence entre deux dates en AA MM et Jours

12 réponses

Votre réponse