Anniversaire

Retour vers Excel

Fêter les anniversaires à temps

Imaginons que nous ayons une liste de nos amis, nous souhaitons tenir à l'oeil leur date d'anniversaire et à l'ouverture du fichier être averti au moins deux jours avant; comme ceci :

Nous appliquons aussi les couleurs conventionnelles sur la police de caractère
Voici le code pour appliquer ceci :

Private Sub Workbook_Open()
'Remet toutes les cellules en noir
Range("B:B").Font.Color = RGB(0, 0, 0)
'pour parcourir une plage de données définie
For Each c In [A1:A12]
'on extrait le mois et le jour de la date de référence
    MoisAnn = Month(c)
    JourAnn = Day(c)
'on compare le mois et le jour trouvés avec aujourd'hui
    If MoisAnn = Month(Now()) And JourAnn = Day(Now()) + 2 Then
'si cela correspond on affiche le résultat et on colore la cellule en vert
             MsgBox "C'est l'anniveraire de" & " " & c.Offset(0, 1) & " " & "dans deux jours"
    c.Offset(0, 1).Font.Color = RGB(0, 255, 0)
    End If
'on compare le mois et le jour trouvés avec aujourd'hui
    If MoisAnn = Month(Now()) And JourAnn = Day(Now()) + 1 Then
'si cela correspond on affiche le résultat et on colore la cellule en jaune
             MsgBox "C'est l'anniveraire de" & " " & c.Offset(0, 1) & " " & "demain"
    c.Offset(0, 1).Font.Color = RGB(255, 178, 0)
    End If
'on compare le mois et le jour trouvés avec aujourd'hui
    If MoisAnn = Month(Now()) And JourAnn = Day(Now()) Then
'si cela correspond on affiche le résultat et on colore la cellule en rouge
             MsgBox "C'est l'anniveraire de" & " " & c.Offset(0, 1)
    c.Offset(0, 1).Font.Color = RGB(255, 0, 0)
    End If
Next
End Sub

Télécharger le fichier exemple Anniversaire

FIN