XL 2016 envoi de mail en automatique en fonction de plusieurs menus deroulants

mathieu20 · 21 Avril 2023

Bonjour,

Je souhaiterais modifier le code ci dessous afin de pouvoir

envoyer un mail en automatique au personnes concernées lorsque les initiales sont renseignées en colonne J, M, P, U

Recevoir une reponse lorsque le sujet est traité pour chaque etape lorsque les colonnes K, N, Q, V sont renseignées avec en destinataire la personne dont les initiales figure en colonne J

Est ce possible d ouvrir un fichier lorsque la colonne G pas a "OUI" ?

Merci

Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRgSel As Range
Dim xOutApp As Object, xMailItem As Object
Dim xMailBody$, Derlig&, Var_A_qui$, Var_Objet$

On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Derlig = Range("M" & Rows.Count).End(xlUp).Row

Set xRg = Range("M3:M" & Derlig)
Set xRgSel = Intersect(Target, xRg)

Var_Objet = Range("A" & xRgSel.Row).Value

' liste des variables pour les adresses mails
Select Case xRgSel.Value
Case "HCH"
Var_A_qui = "HCH@Yahoo.com"
Case "HSE"
Var_A_qui = "HSE@Yahoo.com"
Case "ICE"
Var_A_qui = "ICE@Yahoo.com"
Case "EVI"
Var_A_qui = "EVI@Yahoo.com"
Case "LCA"
Var_A_qui = "LCA@Yahoo.com"
Case "JDE"
Var_A_qui = "JDE@Yahoo.com"
Case "CMA"
Var_A_qui = "CMA@Yahoo.com"
Case "MDU"
Var_A_qui = "MDU@Yahoo.com"
Case "PHC"
Var_A_qui = "PHC@Yahoo.com"
Case "EVA"
Var_A_qui = "EVA@Yahoo.com"
Case "CBE"
Var_A_qui = "CBE@Yahoo.com"

Case Else
MsgBox "Pas trouvé le bon destinataire": Exit Sub 'Facultatif si aucune adresse mail trouvée
End Select

ActiveWorkbook.Save
If Not xRgSel Is Nothing Then
Set xOutApp = CreateObject("Outlook.Application")
Set xMailItem = xOutApp.CreateItem(0)
'texte dans le corp du message
xMailBody = "Merci de créer la FIA, la cellule " & xRgSel.Address(False, False) & " a été renseignée le " & _
Format$(Now, "mm/dd/yyyy") & " at " & Format$(Now, "hh:mm:ss") & " par " & Environ$("username") & "."

With xMailItem
.To = Var_A_qui '"adresse mail en fonction de la variable"
.Subject = Var_Objet & " Action a effectuer " 'remonte la valeur dans la cellule A & " Action a effectuer "
.body = xMailBody
.Display
End With
End If

Set xRgSel = Nothing
Set xOutApp = Nothing
Set xMailItem = Nothing

Application.DisplayAlerts = True
'Application.ScreenUpdating = True
End Sub

Phil69970 · 4 Mai 2023

@mathieu20

si je renseigne les cellules une par une je vais inonder de mails

J'en ai parler au post # 3 et 5 de ce problème pour moi tu traitais les mails ligne par ligne et non en sélection multiple.

Je te propose cette version qui semble fonctionner

@Phil69970

mathieu20 · 2 Mai 2023

Bonjour @Phil69970

Merci beaucoup pour le travail effectué, j ai juste une chose qui ne fonctionne pas comme je le voudrais :

"Recevoir une reponse lorsque le sujet est traité pour chaque etape lorsque les colonnes K, N, Q, V sont renseignées avec en destinataire la personne dont les initiales figure en colonne J" (je me suis trompé je voulais dire K)

Pour les modifications des colonens K, N, Q, V, je voudrais que le destinataire soit toujours celui qui figure en colonne K,
Dans le fichier, le mail est envoyé a la personne dont les initiales figurent dans la colonne precedente soit K, N Q et V

Que dois je modifier pour que les mails sont adressés au pilote qui figure en colonne K ?

Merci beaucoup

mathieu20 · 2 Mai 2023

j ai egalement le xMailBody qui ne remonte pas dans le mail, je ne comprend pas bien pourquoi ?

Phil69970 · 2 Mai 2023

Bonjour @mathieu20

D'abord d'avoir les noms et mails dans la feuille "Param" cela te convient il ?
As tu fait des essais avec mon fichier avec les différends cas de figure et as tu des bugs ?

1 )Que faut il comprendre ?

mathieu20 à dit:
Pour les modifications des colonens K, N, Q, V, je voudrais que le destinataire soit toujours celui qui figure en colonne K,

Qu'est ce qui il aura dans la colonne K le nom ou les initiales ==> donne 1 ou 2 exemples

Si je comprends des que K, N, Q, V sont modifié la macro regarde le nom ou les initiales (J'ai besoin de savoir) en K et envoie le mail au nom ou initiale qui est en K dans l'idéal il faudrait avoir les initiales de la personne à qui envoyer le mail et donc une liste déroulante avec les initiales

En prenant mon fichier du post #15 mets 2 ou 3 exemples que je sois sur de bien comprendre ....

Non testé et fait à la va vite cela devrait peut être le faire avec en colonne K les initiales
==> Si besoin , tu rajoutes toutes les initiales/nom manquantes dans la feuilles "Param" les unes à la suite des autres ET sans trou entre les lignes, ma macro devrait se débrouiller toute seule pour retrouver ses petits

VB:

If Not Intersect(Target, PlageReponse) Is Nothing Then      ' ==> K3 + N3 + Q3 + V3
    DerligParam = Sheets("Param").Range("A" & Rows.Count).End(xlUp).Row
    Lig = Target.Row
    Col = K
    Var_A_qui = Application.VLookup(Cells(Lig, Col), Sheets("Param").Range("A3:B" & DerligParam), 2, False)
    Var_Objet = Range("A" & Target.Row).Value
End If

2) Pour la partie xMailBody a priori je n'ai rien modifier du code existant

3)

Phil69970 à dit:
Mais quid des colonnes
Et la colonne R et X ???
Et la colonne S et Y ???

Je m'absente le reste de la journée donc pas de réponse immédiate de ma part

@Phil69970

mathieu20 · 2 Mai 2023

@Phil69970

Pour l onglet avec les adresses mails, c est parfait, cela permet d ajouter d autres personnes sans modifier le code

1/ En colonne "K" se trouve les initiales du pilotes du projet (ex MDU, CMA ou PHC)
Les initiales de ces personnes se trouvent deja dans l onglet param

Je viens de tester ce changement :

If Not Intersect(Target, PlageReponse) Is Nothing Then ' ==> K3 + N3 + Q3 + V3
DerligParam = Sheets("Param").Range("A" & Rows.Count).End(xlUp).Row
Lig = Target.Row
Col = K
Var_A_qui = Application.VLookup(Cells(Lig, Col), Sheets("Param").Range("A3:B" & DerligParam), 2, False)
Var_Objet = Range("A" & Target.Row).Value
End If

Mais le mail ne se declanche plus en automatique

2/ je viens de verifier avec le code précedent et en effet il n a pas bougé mais ne fonctionne plus, je regarderais si j arrive a comprendre pourquoi

3/ pour les colonnes
R et X ???
S et Y ???

Ces actions sont a faire par le pilote, donc inutile de declancher l envoi d un mail

Merci en tous cas pour ton aide, j ai l impression qu il ne manque pas grand chsoe pour que le code fonctionne comme je le souhaiterais

Bonne soirée a toi

Phil69970 · 2 Mai 2023

@mathieu20

Je suis rentré plus tôt que prévu ....

Je te propose cette version

J'ai modifié légèrement la partie mail et j'ai inclus un message correspondant au corps du mail ....

@Phil69970

mathieu20 · 4 Mai 2023

Bonjour @Phil69970

Désolé, je n ai pas eu le temps de tester le fichier avant,

Je viens de regarder, j ai encore un probleme au niveau des retour de mails

If Not Intersect(Target, PlageReponse) Is Nothing Then ' ==> K3 + N3 + Q3 + V3
DerligParam = Sheets("Param").Range("A" & Rows.Count).End(xlUp).Row
Lig = Target.Row
Col = K
Var_A_qui = Application.VLookup(Cells(Lig, Col), Sheets("Param").Range("A3:B" & DerligParam), 2, False)
Var_Objet = Range("A" & Target.Row).Value
End If

en cas de modification des colonnes K3 + N3 + Q3 + V3, le mail ne s ouvre pas

Est ce que cela fonctionne chez toi ?

Merci

Phil69970 · 4 Mai 2023

Bonjour @mathieu20

On va faire par étape :

1) Le mail fonctionne t'il pour la 1ere partie
==> J3 + M3 + P3 + U3
Tu devrais avoir un message genre

Et le mail est envoyé.....

2) Le mail bloque sur la 2eme partie si j'ai compris
==> K3 + N3 + Q3 + V3
Qu'entends tu par :

mathieu20 à dit:
le mail ne s ouvre pas

As tu le message comme sur la 1ere partie ?

*******

Si c'est bon pour le 1ere partie et pas sur la 2eme partie cela devrait être juste un réglage à faire je regarde cela .

@Phil69970

Phil69970 · 4 Mai 2023

@mathieu20

As tu ce message ?

A priori cela vient de la valeur de la colonne K de la ligne modifié.
Dans K + ligne il doit avoir obligatoirement les initiales de la personne à qui envoyé le mail sinon la recherche ne trouve pas de destinataire et le mail ne part pas

Qu'avais tu prévu de mettre dans la colonne K ?

@Phil69970

Phil69970 · 4 Mai 2023

@mathieu20

Et il faut remplacer

mathieu20 à dit:
Col = K

par

Col = 11

Qu'avais tu prévu de mettre dans la colonne K ?

@Phil69970

mathieu20 · 4 Mai 2023

@Phil69970

Ca fonctionne super bien avec
Col = 11

par contre j ai une fonction qui ne marche plus par rapport au fichier d origine:

Lorsque je rentrais plusieurs fois les initiales "EVA" avec un cipier coller ou en selectionnant plusieurs cellule et ctr+entree, le declanchement du mail se faisait en auto et le body contenait la plage de cellule modifié

Exemple

pour cette modification, j avais un seul mail avec le texte ci dessous

Pour le moment, les mails s ouvrent uniquement lorsqu une seule cellule est modifiée
si je renseigne les cellules une par une je vais inonder de mails

Phil69970 · 4 Mai 2023

@mathieu20

si je renseigne les cellules une par une je vais inonder de mails

J'en ai parler au post # 3 et 5 de ce problème pour moi tu traitais les mails ligne par ligne et non en sélection multiple.

Je te propose cette version qui semble fonctionner

@Phil69970

mathieu20 · 4 Mai 2023

@Phil69970

Oui ca fonctionne parfaitement, merci beaucoup pour ton aide, c est top !!!!!!

XL 2016 envoi de mail en automatique en fonction de plusieurs menus deroulants

mathieu20

XLDnaute Nouveau

Pièces jointes

Phil69970

mathieu20

XLDnaute Nouveau

mathieu20

XLDnaute Nouveau

Phil69970

XLDnaute Barbatruc

mathieu20

XLDnaute Nouveau

Phil69970

XLDnaute Barbatruc

Pièces jointes

mathieu20

XLDnaute Nouveau

Phil69970

XLDnaute Barbatruc

Phil69970

XLDnaute Barbatruc

Phil69970

XLDnaute Barbatruc

mathieu20

XLDnaute Nouveau

Phil69970

XLDnaute Barbatruc

Pièces jointes

mathieu20

XLDnaute Nouveau

Discussions similaires