XL 2019 Prénoms à souhaiter

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

lynyrd

XLDnaute Impliqué
Bonjour le forum
Dans un post précédant on ma fait une VBA que je n'arrive pas à adapter à mon fichier pour avoir une alerte quand la date du prénom est la.
voila le VBA
VB:
Option Explicit

Private Sub workbook_open()
Dim cejour$, der&, t, i&, s$, j&, v
   Rows.Interior.ColorIndex = xlNone
   cejour = Format(Date, "mmdd")          ' mois et jour d'aujourd'hui sur 4 caractères
   With Sheets("Feuil1")                  ' avec la feuille "Feuil1"
      t = .Range("a1:c" & .Cells(Rows.Count, "a").End(xlUp).Row)  ' array des 3 premières colonnes
   End With
   For i = 2 To UBound(t)                          ' boucle sur les personnes
      If Format(t(i, 3), "mmdd") = cejour Then     ' si le jour de naissance est aujourd'hui
         s = s & vbLf & t(i, 1) & Format(Year(Date) - Year(t(i, 3)), "    0 ans")   ' on ajoute la personne
      End If                                                                        ' au texte s
   Next i
   If s <> "" Then      ' si s n'est pas vide
      beep              ' on émet un bip
      MsgBox Mid(s, 2), , "Anniversaires du " & Format(Date, "d mmmm")   ' et on affiche les anniversaires
   End If
   With Sheets("prénoms a feter")                                    ' avec la feuille "prénoms a feter""
      s = ""                                                         ' remet s à vide
      v = .Range("a1:b" & .Cells(Rows.Count, "a").End(xlUp).Row)     ' array des deux premières colonnes
   End With
   For i = 2 To UBound(v)                          ' boucle sur les prénoms
      If Format(v(i, 1), "mmdd") = cejour Then     ' si le prénom se fête aujourd'hui
         'on normalise le prénom : minuscule avec un espace devant et un espace derrière
         v(i, 2) = Trim(LCase(v(i, 2))): v(i, 2) = UCase(Left(v(i, 2), 1)) + Mid(v(i, 2), 2)
         v(i, 2) = " " & v(i, 2) & " "
         ' on va tester si le nom de la personne (qu'on entoure d'un espace) contient le prénom à fêter
         'ou si le nom de la personne (qu'on entoure d'un espace) contient le prénom à fêter avec une majuscule
         For j = 2 To UBound(t)
            If " " & t(j, 1) & " " Like "*" & v(i, 2) & "*" Or _
               " " & t(j, 1) & " " Like "*" & LCase(v(i, 2)) & "*" Then    ' le test est positif
               s = s & vbLf & t(j, 1)                                      ' on ajoute la personne
            End If                                                         ' au texte s
         Next j
      End If
   Next i
   If s <> "" Then      ' si s n'est pas vide
      beep              ' on émet un bip
      MsgBox Mid(s, 2), , "Fêtes du " & Format(Date, "d mmmm")     ' et on affiche les fêtes du jour
   End If
End Sub


et j'aurai autre chose à vous demander c'est quand il existe plusieurs prénoms pour une meme date
serait t'il possible d'avoir plusieurs prénoms séparés par "-"
merci.
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
707
Réponses
10
Affichages
533
Retour