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