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
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.
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 Subet 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.
