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

lp_sptp

XLDnaute Nouveau
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

XLDnaute Accro
Bonsoir,
Essayez ça :
VB:
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
 
Dernière édition:

lp_sptp

XLDnaute Nouveau
Bonsoir,
Essayez ça :
VB:
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 !
 

Pièces jointes

  • Formation classeur test - Copie.xlsm
    61.3 KB · Affichages: 3

Gégé-45550

XLDnaute Accro
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) :
VB:
monmail.Attachments.Add chemin_complet_vers_monimage, olByValue, 0
Puis dans le texte :
Code:
"<img src='monimage.png'" & "width='98' height='85'>"
Cordialement,
 

lp_sptp

XLDnaute Nouveau
@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

XLDnaute Accro
@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

XLDnaute Nouveau

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

 

Pièces jointes

  • Test facturation - Copie.xlsm
    39 KB · Affichages: 3

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 912
Membres
101 837
dernier inscrit
Ugo