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

mathieu20

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

Pièces jointes

  • test tracker VBA.xlsm
    25.9 KB · Affichages: 11

mathieu20

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

Phil69970

XLDnaute Barbatruc
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 ?

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

1683028591770.png


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)
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

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

mathieu20

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

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

1683181923695.png


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 :
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

XLDnaute Barbatruc
@mathieu20

As tu ce message ?

1683183584933.png


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
 

mathieu20

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

1683201177984.png

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


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
 

Statistiques des forums

Discussions
312 209
Messages
2 086 270
Membres
103 168
dernier inscrit
isidore33