Nombre de jour entre aujourd'hui et la date d'anniversaire

[ifi77]

Bonjour à tous,

j'essaye de créer un code qui permet de donner le nombre de jour restant jusqu'a la procahine date anniversaire.

Si quelqu'un a déja fait ce type de code cela m'interesserais.

Merci

@+

 

[Etienne2323]

Re : Nombre de jour entre aujourd'hui et la date d'anniversaire

Salut ifi77,
supposons ceci :
en A1 la date d'aujourd'hui

=AUJOURDHUI()

en B1 la date du prochain anniversaire

Tu n'as qu'à inscrire en C1 la formule suivante :

=B1-A1

Bonne continuité,

Étienne

 

[ifi77]

Re : Nombre de jour entre aujourd'hui et la date d'anniversaire

Bonjour Étienne, en fait je cherche le code vba qui me permet a partir d' une date récupérée lors d' une boucle, d' alimenter une listbox si la différence est égal a 2,1 ou 0.

Si tu as une idée

Merci

 

[Habitude]

Re : Nombre de jour entre aujourd'hui et la date d'anniversaire

Bonjour

Serait plus simple avec un Fichier.

Autrement

Tu dois prendre la date anniversaire, extraire le mois et le jour, ensuite lui donné l'année de la date récupérée.
Ensuite tu soustrait la date récupérée à la date calculée. Et tu auras le nombre de jour. Dans la cas d'un nombre négatif, c'est que l'anniversaire est déjà passé.

 

[ifi77]

Re : Nombre de jour entre aujourd'hui et la date d'anniversaire

Bonsoir habitude,

en fait le fichier est un peu important pour le mettre, je te mets le code me permettant de comparer le nombre de mois et d'incrire sur la listbox en fonction de critères de nombre

j'aimerais adapter ce code pour cette fois ci calculer le nombre de jour séparant la date d'aujourd hui et celle de la date d'anniversaire, sachant que celle figurant sur la base de donnée en .cells(i,8) est la date de naissance.

With Sheets("formationbspp")

For i = 2 To .Range("A65536").End(xlUp).Row
If .Cells(i, 8).Value <> "" Then
NbMois = DateDiff("d", .Cells(i, 8).Value, Date, vbMonday, vbFirstFourDays) + (Day(Date) < Day(.Cells(i, 8).Value))
'If Nbjours = 2 Then

If LstNoms8(1, 1) <> "" Then ReDim Preserve LstNoms8(1 To 3, 1 To UBound(LstNoms8, 2) + 1)

LstNoms8(1, UBound(LstNoms7, 2)) = .Cells(i, 1).Value
LstNoms8(2, UBound(LstNoms7, 2)) = .Cells(i, 2).Value
LstNoms8(3, UBound(LstNoms7, 2)) = "Après demain"
End If

End If
Next i
Me.ListBox8.Column = LstNoms8
End With

Merci

@+

 

[Habitude]

Re : Nombre de jour entre aujourd'hui et la date d'anniversaire

For i = 2 To .Range("A65536").End(xlUp).Row
 If .Cells(i, 8).Value <> "" Then
 NbMois = DateDiff("d", .Cells(i, 8).Value, Date, vbMonday, vbFirstFourDays) + (Day(Date) < Day(.Cells(i, 8).Value))
 'If Nbjours = 2 Then
.....

Je ferais comme ceci, à tester

Dim laDate As Date, nbJours As Single
For i = 2 To .Range("A65536").End(xlUp).Row
         If .Cells(i, 8).Value <> "" Then
               laDate = .Cells(i, 8).Value
               laDate = CDate(Day(laDate) & "/" & Month(laDate) & "/" & Year(Date))
               nbJours = laDate - Date

               .....
         End If

 

[ifi77]

Re : Nombre de jour entre aujourd'hui et la date d'anniversaire

Bonjour Habitude, tout d'abord merci pour ta réponse

sans avoir eu le temps de regarder ta solution car l'ordinateur était déja eteint, j'ai réussi ce matin à trouver une solution similaire à la tienne, et cela fonctionne:

With Sheets("rensprivés")
Dim moisanniv, jouranniv As Byte
Dim ans As Integer

For i = 2 To .Range("A65536").End(xlUp).Row
If .Cells(i, 8).Value <> "" Then

moisanniv = Month(.Cells(i, 8).Value)
jouranniv = Day(.Cells(i, 8).Value)
ans = Year(Date)
Nbjour = DateDiff("d", jouranniv & "/" & moisanniv & "/" & ans, Date)

If Nbjour = 2 Then

If LstNoms8(1, 1) <> "" Then ReDim Preserve LstNoms8(1 To 3, 1 To UBound(LstNoms8, 2) + 1)

LstNoms8(1, UBound(LstNoms8, 2)) = .Cells(i, 1).Value
LstNoms8(2, UBound(LstNoms8, 2)) = .Cells(i, 2).Value
LstNoms8(3, UBound(LstNoms8, 2)) = "Après demain"

ElseIf Nbjour = 1 Then

If LstNoms8(1, 1) <> "" Then ReDim Preserve LstNoms8(1 To 3, 1 To UBound(LstNoms8, 2) + 1)

LstNoms8(1, UBound(LstNoms8, 2)) = .Cells(i, 1).Value
LstNoms8(2, UBound(LstNoms8, 2)) = .Cells(i, 2).Value
LstNoms8(3, UBound(LstNoms8, 2)) = "Demain"

ElseIf Nbjour = 0 Then

If LstNoms8(1, 1) <> "" Then ReDim Preserve LstNoms8(1 To 3, 1 To UBound(LstNoms8, 2) + 1)

LstNoms8(1, UBound(LstNoms8, 2)) = .Cells(i, 1).Value
LstNoms8(2, UBound(LstNoms8, 2)) = .Cells(i, 2).Value
LstNoms8(3, UBound(LstNoms8, 2)) = "Aujourd'hui"

End If


End If
Next i
Me.ListBox8.Column = LstNoms8
End With

Il me reste plus qu'à classer les dates dans la listbox en croissant et normalement le tour est joué, merci de ton aide,

@+

 

[ifi77]

Re : Nombre de jour entre aujourd'hui et la date d'anniversaire

et finalement en supprimant les variables,

Nbjour = DateDiff("d", Day(.Cells(i, 8).Value) & "/" & Month(.Cells(i, 8).Value) & "/" & Year(Date), Date)

encore merci

@+

 

[YANN-56]

Re : Nombre de jour entre aujourd'hui et la date d'anniversaire

Bonsoir ifi, Etienne, Habitude, et à ceux qui passeront par là,

Ci-joint une petite bidouille dont tu pourras peut-être tirer quelque chose.

(Désolé de ne pas savoir travailler sur une Feuille)

Amicalement,

Yann

 

[ifi77]

Re : Nombre de jour entre aujourd'hui et la date d'anniversaire

Merci yann, très interessant, je mets cela de coté car il y a fort à parier que je m'en servirais bientot.

Encore merci

@+

 

[YANN-56]

Re : Nombre de jour entre aujourd'hui et la date d'anniversaire

Bonjour ifi, aux participants, et à ceux qui passeront par ici,

Je suis bien heureux que mon p'tit truc te plaise.

Pour l'historique; je l'avais fait lorsque j'étais en entreprise,
pour ne pas louper les anniversaires....... Cela fait toujours plaisir.

Etant en réseau, je me servais du Fichier du personnel qui était sur le serveur.
Ce qui explique le fait de puiser les infos ailleurs que dans une feuille du Classeur maître.
Le module était dans une appli utilisée tous les jours par plusieurs collègues...... Donc info inévitable!

Le reste de la présentation "Œil", "WebBrowser" n'étaient là que pour faire joli et un peu "Pro"

Le code est totalement, et facilement adaptable en se passant de l'USF, et en écrivant sur une feuille.

Je suis persuadé que tu sauras le faire.

Amicalement,

Yann