Calendrier automatique

Phoenix23

XLDnaute Occasionnel
Bonsoir à toutes et tous,
Mon problème: Un calendrier automatique qui calcul le temps passé depuis la date de naissance, j'ai trouvé, modifié une formule trouvée sur internet pour les années, mois, jours passés, mais je bloque pour les heures, minutes secondes.
D'avance merci pour votre aide
Cordialement
 

Pièces jointes

  • Classeur2.xlsx
    10.2 KB · Affichages: 153
  • Classeur2.xlsx
    10.2 KB · Affichages: 151
  • Classeur2.xlsx
    10.2 KB · Affichages: 161

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:

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.
 

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:

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 !
 

Pièces jointes

  • 3calendrier-automatique-age-2R-.xlsm
    32.3 KB · Affichages: 90
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:

Modeste geedee

XLDnaute Barbatruc
Re : Calendrier automatique

Bonsour®

:mad:
no comment !!!
Capture.JPG
 

Pièces jointes

  • Capture.JPG
    Capture.JPG
    63.2 KB · Affichages: 112
  • Capture.JPG
    Capture.JPG
    63.2 KB · Affichages: 116

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
 

Pièces jointes

  • Âge(3).xlsm
    36 KB · Affichages: 98

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:

Discussions similaires