Calendrier automatique

Lone-wolf

XLDnaute Barbatruc
Re : Calendrier automatique

Bonjour Staple,

et bien voilà le résultat Or 49 years, 9 days excluding the end date.

Avec Inclure la date de fin de calcul (1 jour est ajouté) 49 ans et 10 jours, mais c'est faux.

Qu'est-ce qu'on nous a appris à l'école?

16 + ... = 25, vous êtes sûr que ça fait 10 ???



A+ :cool:
 

Staple1600

XLDnaute Barbatruc
Re : Calendrier automatique

Re

Le 16 est le jour 1
Le 17 est le jour 2
Le 18 est le jour 3
Le 19 est le jour 4
Le 20 est le jour 5
Le 21 est le jour 6
Le 22 est le jour 7
Le 23 est le jour 8
Le 24 est le jour 9
Le 25 est le jour 10

Donc ce n'est point faux.
49 ans 0 mois 9 jours ou 10 jours sont OK mais 8 pas OK.

Maintenant tu as le droit de ne pas être d'accord ;)
 
Dernière édition:

Lone-wolf

XLDnaute Barbatruc
Re : Calendrier automatique

Re Staple,

C'est ce que j'ai dit au post #37. Moi je suis à 100% d'accord avec toi.

Et dans la macro du post 33, si tu regarde, j'ai rajouté + 1 à Day pour avoir le juste résultat.



A+ :cool:
 

Lone-wolf

XLDnaute Barbatruc
Re : Calendrier automatique

Re Stapple,

et c'est bien 8 jours que la fonction proposé par Bernard donne comme résultat.



Code:
Function EcartDate(DatNaissance As Date, DatEnCours As Date)
'D'après une procédure de Roland_M
Dim Annee, Mois, Jour
  Annee = Year(DatEnCours - DatNaissance) - 1900
  Mois = Month(DatEnCours - DatNaissance) - 1
  Jour = Day(DatEnCours - DatNaissance)
  If Jour >= 31 Then Mois = Mois + 1: Jour = 0
  If Mois >= 12 Then Annee = Annee + 1: Mois = 0
  EcartDate = Array(Annee, Mois, Jour) 'Renvoie un vecteur-ligne à trois composantes.
End Function
Fait un test avec 16.01.1965 et regarde à droite le résultat = { }

Ensuite tu met 15.01.1965, quel'est le résultat obtenu?


A+ :cool:
 

Staple1600

XLDnaute Barbatruc
Re : Calendrier automatique

Re__________________[Voir EDITION en bas du message]

J'ai retrouvé dans mes archives cette fonction de Chip Pearson qui elle renvoie 9
Mais bon personnellement un calendrier en carton accroché au mur me suffit
Quand à calculer un age, si j'ai besoin je peux toujours demander à la personne concernée
(sauf si c'est une dame bien sur)
Bref, je vous laisse avec Chronos et vous saluez bien pour moi les Maitres du Temps et Docteur Who ;)
Code:
Function Age(Date1 As Date, Date2 As Date) As String
'origine: Chip Pearson
    Dim Y%, M%, D%, Temp1 As Date
    Temp1 = DateSerial(Year(Date2), Month(Date1), Day(Date1))
    Y = Year(Date2) - Year(Date1) + (Temp1 > Date2)
    M = Month(Date2) - Month(Date1) - (12 * (Temp1 > Date2))
    D = Day(Date2) - Day(Date1)
    If D < 0 Then
        M = M - 1
        D = Day(DateSerial(Year(Date2), Month(Date2) + 1, 0)) + D + 1
    End If
    Age = Y & " année(s) " & M & " mois " & D & " jour(s)"
End Function
Code:
Sub test()
MsgBox Age(DateSerial(1965, 1, 16), Date)
End Sub
EDITION: Donc en suivant l'exemple de Chip, EcartDate renvoie aussi 9 ;)
Sub test()
MsgBox EcartDate(DateSerial(1965, 1, 16), Date)
End Sub

Code:
Function EcartDate(DatNaissance As Date, DatEnCours As Date) As String
'D'après une procédure de Roland_M
Dim Annee, Mois, Jour
Annee = Year(DatEnCours - DatNaissance) - 1900
Mois = Month(DatEnCours - DatNaissance) - 1
Jour = Day(DatEnCours) - Day(DatNaissance)
If Jour >= 31 Then Mois = Mois + 1: Jour = 0
If Mois >= 12 Then Annee = Annee + 1: Mois = 0
EcartDate = Annee & " | " & Mois & " | " & Jour
End Function
 
Dernière édition:

Lone-wolf

XLDnaute Barbatruc
Re : Calendrier automatique

Re Staple,

est-ce que tu as fait le test directement sur la feuille? Tu verras, il s'y passent des choses bizarres??? :confused: :confused: :confused:
 

Staple1600

XLDnaute Barbatruc
Re : Calendrier automatique

Re

Les macros dans mon précédent message renvoient 9.
(Tu as vu la modif que j'ai faite dans EcartDate?)
Et non je n'ai pas testé dans le fichier, car je ne suis que lecteur de ce fil ;)
J'ai testé les codes de mon message précédent dans VBE et dans les deux cas, ils renvoient 9.
 

Lone-wolf

XLDnaute Barbatruc
Re : Calendrier automatique

Re Staple,

je pense qu'en mettant EcartDate = Array(Annee, Mois, Jour) au lieu de EcartDate = Annee & " | " & Mois & " | " & Jour, c'est ça qui causait l'écart de 1 jour.


A+ :cool:
 

Staple1600

XLDnaute Barbatruc
Re : Calendrier automatique

Re

Lone-wolf (lunettes défaillantes? ;) )
Je ne parlais pas de cette modif, mais de celle-ci ;):rolleyes:
Jour = Day(DatEnCours) - Day(DatNaissance)
(puisque elle reprend la syntaxe de l'exemple de Chip Pearson comme je le précisais pourtant)

Pour mémoire dans le code initial que tu citais, on avait:
Jour = Day(DatEnCours - DatNaissance)
 
Dernière édition:

Lone-wolf

XLDnaute Barbatruc
Re : Calendrier automatique

Eeeeuuuuhh, ein choux le di goung :eek::eek:

c'est vrai, je n'ais pas fait attention a cette ligne.


Toutes mes excuses Staple.


A+ :cool:
 

Roland_M

XLDnaute Barbatruc
Re : Calendrier automatique

re
bien le bonjour à tous,

ci-joint ma dernière mise au point !
pour moi c'est ok ! voir explications !?

en attente de remarques (objectives) toujours bien venues !

et bien entendu notre ami et Maître ROGER2327 !

EDIT: pour ceux qui l'auraient chargé, j'ai fais une petite correction !
 

Fichiers joints

Dernière édition:

Lone-wolf

XLDnaute Barbatruc
Re : Calendrier automatique

Bonjour Roland,

une autre variante qui a l'air d'être correcte.


Code:
Function AGE(Date_de_naissance As Date, Date_du_jour As Date) As String
  Dim Elt As Long, D1 As Long, D2 As Long
  D1 = Int(Date_de_naissance): D2 = Int(Date_du_jour)
  Elt = Evaluate("DATEDIF(" & D1 & "," & D2 & ",""y""")
  AGE = Elt & IIf(Elt > 1, " ans, ", " an,") & _
    Evaluate("DATEDIF(" & D1 & "," & D2 & ",""ym""") & " mois, "
  Elt = Evaluate("DATEDIF(" & D1 & "," & D2 & ",""md""")
  AGE = AGE & Elt & IIf(Elt > 1, " jours", " jour")
  AGE = Replace(AGE, ",", " - ")
End Function

A+ :cool:
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re : Calendrier automatique

Bonsoir à tous

Lone-wolf
Juste avant d'aller dodo, une dernière suggestion en guise d'alarme
Tu trouveras dans les archives du forum ou avec G..gle pourquoi il faut bannir l'emploi de DATEDIF ;)

editiON. BONSOIR modestegeedee
j'avais déjà enfiler mon pyjama
Désolé pour la collision ;)
Bonne nuit à tous
 

ROGER2327

XLDnaute Barbatruc
Re : Calendrier automatique

Re...


re
bien le bonjour à tous,

ci-joint ma dernière mise au point !
pour moi c'est ok ! voir explications !?

(...)
Beau boulot, il me semble qu'on ne peut guère améliorer. De mon côté, j'ai mis un temps fou à comprendre mon erreur. C'est dans la gestion des heures que je me suis lourdement planté !

Voici une version différente qui me donnent les mêmes résultats que les vôtres (la fonction auxiliaire DecMois fait le même boulot que la fonction native MOIS.DECALER() d'Excel) :​
VB:
Function DifDate(début As Date, fin As Date) 'ROGER2327
Dim D As Date, F As Date, T&, Jo%, dH#, HMS As Variant
  Application.Volatile
  If début < fin Then D = début: F = fin + 1 Else D = fin: F = début + 1
  dH = F - Int(F) - D + Int(D)
  F = Int(F) + (dH < 0)
  D = Int(D)
  HMS = Split(Format(dH - (dH < 0), "h m s"))
  T = 12 * (Year(F) - Year(D) - 1)
  Do While DecMois(D, T + 4) < F: T = T + 4: Loop
  Do While DecMois(D, T + 1) < F: T = T + 1: Loop
  Jo = F - DateSerial(Year(DecMois(D, T)), Month(DecMois(D, T)), 1 + Day(DecMois(D, T)))
  DifDate = Array(T \ 12, T Mod 12, Jo, CInt(HMS(0)), CInt(HMS(1)), CInt(HMS(2))) 'Renvoie un vecteur-ligne à six composantes.
End Function

Function DecMois(D As Date, dec&) As Date 'ROGER2327
Dim x, y
  x = DateSerial(Year(D), Month(D) + dec, 1)
  y = Day(DateSerial(Year(x), Month(x) + 1, 0))
  DecMois = DateSerial(Year(D), Month(D) + dec, (y + Day(D) - Abs(y - Day(D))) / 2)
End Function

Dans le classeur joint, j'ai repris nos dernières versions.

Je pense que, comme vous, je vais en rester là, sauf si une autre erreur grossière est détectée par un lecteur...



Bonne journée.


ℝOGER2327
#7129


Lundi 2 Gueules 141 (Saint Sigisbée, eunuque - fête Suprême Quarte)
8 Pluviôse An CCXXII, 1,1253h - mézéréon
2014-W05-1T02:42:03Z
 

Fichiers joints

Roland_M

XLDnaute Barbatruc
Re : Calendrier automatique

re:

tout à fait ROGER !

effectivement, concernant les heures, c'est pour cela que j'ai volontairement laissé tomber !
pour ma macro si l'heure de naissance était supérieure il me suffisait de déduire un jour du jour en cours !

en tous les cas, beau travail !

maintenant je dois préciser une chose très importante concernant la réalisation de ma macro !
c'est grâce à votre classeur avec la comparaison immédiate que j'ai pu la mettre au point !
sans ça je ne suis pas certain que j'en serais arrivé là !

bravo et au plaisir de vous croiser !


EDIT:
@Lone wolf: la fonction DateDiff ne fonctionne pas correctement !
 
Dernière édition:

13GIBE59

XLDnaute Accro
Re : Calendrier automatique

Bonjour à tous,

Je ne sais pas pourquoi, mais j'aime bien ce fil...du temps qui passe.
 

Lone-wolf

XLDnaute Barbatruc
Re : Calendrier automatique

Rebonjour,


Sans1.jpg
Sans2.jpg


EDIT: @Roland, si tu regarde bien la fonction; qui fait le travail, DATEDIF ou EVALUATE?





A+ :cool:
 
Dernière édition:

Discussions similaires


Haut Bas