XL 2016 VBA Excel : Valeur récapituler sur un seul Mail

[lp_sptp]

Bonjour à tous,

Je viens vers vous pour que vous pouviez m'aider sur ma VBA et je bloque vraiment.

J'ai un fichiers EXCEL qui ressence les différentes formation du personnels de mon entreprise. Ce fichiers sert à savoir quand se périme leurs formation.
En colonne A = leurs noms
En colonne B = la Formation
En colonne E = la date d'expiration
En colonne C = le statuts de leurs formation (Valide ou Arrive à expiration ou Expire)

Dans la colonne C, à l'aide d'une formule, j'ai reussi a automatisé le statut de leurs formation selon la date d'aujourdhui et la date d'expiration de leurs formation.

J'ai ensuite créer une VBA qui permet de m'envoyer un mail quand la colonne C à un statut "Arrive à Expiration" avec dans le corps du mail : le nom de la personne et la formation qui va expirer. Cependant quand j'ai plusieurs formation qui arrive à expiration ça m'envoie un mail pour chaque personne. J'aimerais regrouper les noms et les formation qui sont en statut "arrive à expiration" dans un seul et même mail. Voici mon code VBA :

Sub EMAIL()

Dim LeMail As Variant

For ligne = 10 To 3000

If Range("F" & ligne) = "Arrive à expiration" Then

Set LeMail = CreateObject("Outlook.Application")


With LeMail.CreateItem(0)

.Subject = "Expiration de Formation"

.To = "l.poncet@sptp-savoie.com"

.Body = "Bonjour, <br /><br />"
.Body = .Body & "La formation " & Range("c" & ligne) & " de " & Range("b" & ligne).Value & " va expirer dans 2 mois. <br /><br />"
.Body = .Body & "Veuillez consulter le fichier des formations et renouveler la formation.<br /><br /><br />"
.Body = .Body & "Cordialement.<br /><br />"
.HTMLBody = .Body & "<b>Gestionaire des Formations SPTP</b>"


.Display

End With

End If

Next ligne

End Sub

Si quelqu'un pourrait m'aider ce serait formidable. Merci d'avance.

 

[Gégé-45550]

Bonsoir,
Essayez ça :

Sub EMAIL()

Dim LeMail As Variant, TabDest as Collection, Compteur&, i&, Liste$, Accord$
Set TabDest = New Collection
Compteur=0

For ligne = 10 To 3000

If Range("F" & ligne) = "Arrive à expiration" Then

    TabDest.Add "- " & "La formation " & Range("C" & ligne) & " de " & Range("B" & ligne)
    Compteur=Compteur +1

End If

Next ligne

If Compteur > 0 then
 For i=1 to Compteur
    Liste = TabDest.Item(i) & Chr(10)
 Next i

Set LeMail = CreateObject("Outlook.Application")


With LeMail.CreateItem(0)

.Subject = "Expiration de Formation"

.To = "l.poncet@sptp-savoie.com"

.Body = "Bonjour, <br /><br />"

If Compteur > 1 Then Accord = " vont expirer dans 2 mois. <br /><br />" Else Accord = " va expirer dans 2 mois. <br /><br />"
.Body = .Body & Liste & Accord
.Body = .Body & "Veuillez consulter le fichier des formations et renouveler la formation.<br /><br /><br />"
.Body = .Body & "Cordialement.<br /><br />"
.HTMLBody = .Body & "<b>Gestionnaire des Formations SPTP</b>"


.Display

End With
End If
Set TabDest = Nothing
Set LeMail = Nothing
End Sub

Cordialement

 

[lp_sptp]

Bonsoir,
Essayez ça :

Sub EMAIL()

Dim LeMail As Variant, TabDest as Collection, Compteur&, i&, Liste$, Accord$
Set TabDest = New Collection
Compteur=0

For ligne = 10 To 3000

If Range("F" & ligne) = "Arrive à expiration" Then

    TabDest.Add "- " & "La formation " & Range("C" & ligne) & " de " & Range("B" & ligne)
    Compteur=Compteur +1

End If

Next ligne

If Compteur > 0 then
 For i=1 to Compteur
    Liste = TabDest.Item(i) & Chr(10)
 Next i

Set LeMail = CreateObject("Outlook.Application")


With LeMail.CreateItem(0)

.Subject = "Expiration de Formation"

.To = "l.poncet@sptp-savoie.com"

.Body = "Bonjour, <br /><br />"

If Compteur > 1 Then Accord = " vont expirer dans 2 mois. <br /><br />" Else Accord = " va expirer dans 2 mois. <br /><br />"
.Body = .Body & Liste & Accord
.Body = .Body & "Veuillez consulter le fichier des formations et renouveler la formation.<br /><br /><br />"
.Body = .Body & "Cordialement.<br /><br />"
.HTMLBody = .Body & "<b>Gestionnaire des Formations SPTP</b>"


.Display

End With
End If
Set TabDest = Nothing
Set LeMail = Nothing
End Sub

Cordialement

Bonjour @Gégé-45550,

Merci pour votre réponse et votre recherche, j'ai essayer votre programme et j'ai effectivement plus que un mail mais il prends en compte que la dernière personne du tableau qui a le statut "Arrive à expiration" et pas toutes les personnes avec ce status. Je vois pas comment je pourrais modifier votre programme (pourtant j'ai essayé). Je vous laisse le fichier ci-joint pour pouvoir mieux m'aider peut être. Merci d'avance.


Bonne journée !

 

[Gégé-45550]

Voilà !
Cordialement

 

[lp_sptp]

Merci beaucoup Gégé-45550 !
Je voulais te poser une dernière question est ce que tu sais rajouter une image pour mettre en dessous de la signature ? J'ai essayer mais ça m'affiche un lien ou alors plus rien du tout. Merci d'avance.

 

[Gégé-45550]

Bonjour,
a priori, je pense qu'il est nécessaire mettre l'url d'une image stockée sur un serveur web accessible au public visé.
Sinon, essayez ceci (à adapter) :

monmail.Attachments.Add chemin_complet_vers_monimage, olByValue, 0

Puis dans le texte :

"<img src='monimage.png'" & "width='98' height='85'>"

Cordialement,

 

[lp_sptp]

@Gégé-45550 Désolé de te déranger mais tu a l'air vraiment caler en VBA. Deuxième petite question je voulais savoir comment exécuter cette même macro mais sur trois feuille en même temps avec trois adresse mail différentes. Lorsque que je clique sur le Boutons de la macro ca m'envoye trois mail avec les trois adresse mail différentes. Merci d'avance de ton temps

 

[Gégé-45550]

@Gégé-45550 Désolé de te déranger mais tu a l'air vraiment caler en VBA. Deuxième petite question je voulais savoir comment exécuter cette même macro mais sur trois feuille en même temps avec trois adresse mail différentes. Lorsque que je clique sur le Boutons de la macro ca m'envoye trois mail avec les trois adresse mail différentes. Merci d'avance de ton temps

Il suffit de faire une boucle.
For i=1 to 3
'envoi du mail N° i à partir des données de la feuille i'
next i

 

[lp_sptp]

Gégé-45550 Merci pour l'insertion de l'image j'ai un peu modifié ton code car ça m'effacer tout le mail, mais j'ai réussi à l'insérer tout de même ! Pour ce qui est de mon fichier excel avec ton code VBA ,qui envoie le mail selon la feuilles 1,2 ou/et 3 et selon un destinataire par feuille je suis pas très douer en VBA et je n'arrive pas à faire ce que tu m'as écris. Je ne veux pas abuser de toi mais tu es vraiment caler je te laisse mon fichier en pièce jointe pour voir si tu peux y arriver. Vraiment je te remercie pour ton aide tu me sauve.​

 

[lp_sptp]

J'ai reussi avec plusieurs macro car je lance les macros avec un script donc je lance une macro par feuille et cela fonctionne

 

[Gégé-45550]

Sinon, il y a ça