Code vba pour lancer l'envoi

Résolu
barbarosilm -  
Bonjour,

suis nouveau sur vba j'ai un souci , je veux écrire un code sur un tableau Excel de façon que quand j'ai la phrase "pas fait " d'éclanche automatiquement l'envoie d'un mail
merci pour votre aide

30 réponses

Résumé de la discussion

Problème posé : un utilisateur souhaite qu'un message Outlook soit envoyé automatiquement lorsqu'un texte exact 'pas fait' est saisi dans une plage Excel, par déclenchement d'un changement sur la feuille. Plusieurs propositions montrent l'utilisation d'un événement VBA Worksheet_Change, d'un intervalle Intersect sur D30:W150, et l'envoi via Outlook avec une fonction EnvoiMail, le corps HTML et le lien vers le fichier. Les réponses évoquent des variantes techniques, notamment des méthodes pour afficher ou envoyer directement le mail, des erreurs possibles et des éléments de sécurité autour de l'accès Outlook. D'autres échanges suggèrent de tester le déclenchement automatique, d'utiliser un exemple partagé ou d'opter pour l'affichage plutôt que l'envoi direct, et d'ajouter des précisions sur les plages et les conditions.

Bobot (l’IA à votre service)
  1. barbarosilm Auteur
    merci pour la réponce c'est comme je veux ,voici le code final : 

    Dim xRg As Range
'Update by Extendoffice 2018/3/7
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Cells.Count > 1 Then Exit Sub
  Set xRg = Intersect(Range("D30:W150"), Target)
    If xRg Is Nothing Then Exit Sub
 If Target.Value = "pas fait" Then
        Call EnvoiMail
    End If
End Sub


Sub EnvoiMail()
Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String


        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)


        strbody = "<font size=""3"" face=""Calibri"">" & _
                  "Bonjour,<br><br>" & _
                  "Le remplacement de mélangeur <B> " & Cells(ActiveCell.Row, 3).Value & " </B>n'est pas fait, merci d'en faire suite." & _
                  "<br><br>Cliquez sur ce lien pour ouvrir le fichier concerné : " & _
                  "<A HREF=""file://\\SERVEUR\Services\DCI\Service%20Informatique\Système%20et%20Réseau\Système\Documentation\" & Cells(ActiveCell.Row, 3).Value & ".docx" _
                  & """>ici</A>" & "<br><br>Cordialement," & _
                  "<br><br>Messsage automatique</font>"


        With OutMail
            .To = "adress mail"
            .CC = ""
            .BCC = ""
            .Subject = "MELANGEUR - remplacement nécessaire"
            .HTMLBody = strbody
            .Send
        End With
        On Error GoTo 0
        Set OutMail = Nothing
        Set OutApp = Nothing
End Sub
    1
    1. f894009
      Bonjour,

      sur vba j'ai un souci
      Vous connaissez la programmation VBA ?
      0
      1. barbarosilm Auteur
        bonjour
        oui un petit peu
        0
        1. barbarosilm Auteur
          je cous envoi le code : 

          Sub worksheet_change(ByVal target As Range)
Set target = Range("D30:W150")
If target.Value = "pas fait" Then
Call EnvoiMail
    End If
End Sub
Sub EnvoiMail()
Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String


        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)


        strbody = "<font size=""3"" face=""Calibri"">" & _
                  "Bonjour,<br><br>" & _
                  "Le remplacement de mélangeur <B> " & Cells(ActiveCell.Row, 3).Value & " </B>n'est pas fait, merci d'en faire suite." & _
                  "<br><br>Cliquez sur ce lien pour ouvrir le fichier concerné : " & _
                  "<A HREF=""file://\\SERVEUR\Services\DCI\Service%20Informatique\Système%20et%20Réseau\Système\Documentation\" & Cells(ActiveCell.Row, 3).Value & ".docx" _
                  & """>ici</A>" & "<br><br>Cordialement," & _
                  "<br><br>Messsage automatique</font>"


        With OutMail
            .To = ""
            .CC = ""
            .BCC = ""
            .Subject = "MELANGEUR - remplacement nécessaire"
            .HTMLBody = strbody
            .Send
        End With
        On Error GoTo 0
        Set OutMail = Nothing
        Set OutApp = Nothing
End Sub
          0
          3. barbarosilm Auteur
            bonjour
            je reviens vers vous car j'ai besoin d'un coup de main
            de coup je veux faire un boucle de façon que chaque fois quand j'ai une plage de cellules expl (D8:E100) je doit envoyer une message différent dans le mail, alors suis obliger de répéter le code 10 fois chaque fois la plage sa change :
            ("F8:G100"): autre message .....
            ya pas un code ou un boucle que je peux le mettre
            merci pour votre coopérationhttps://www.cjoint.com/c/LFkh3BkJLm6
            0
            1. barbarosilm Auteur
              https://www.cjoint.com/c/LFkh3BkJLm6
              0
              1. f894009
                Bonjour,

                Je recupere le fichier et regarde la chose

                alors suis obliger de répéter le code 10 fois chaque fois la plage sa change :
                Pouvez expliquer un peu plus?

                FAIT/PAS FAIT colonne D/F ok, mais E/G normalement devrait y avoir quoi ?

                Sub EnvoiMail() a deux endroits!! Pourquoi?
                0
                1. berberi
                  bonjour
                  le code fonctionne a merveille , moi je veux aller plus loin et je veux envoyer pour chaque plage de celulle le meme mail mais avec le contenu différent jexplique :
                  exemple le lundi , sur la ligne 2 et dans la plage (D8:E100) on a ecrit""pas fait"" de coup on génére un mail , le mercredi sur la ligne 3 dans la plage("F8:G100") on écrit"pas fait" le meme mail aussi et pour tous le reste mais le corp différent de facon que chaque plage des celulle corespond a un mail , jespère que j'étais claire
                  voici le code : 

                  Dim xRg As Range
'Update by Extendoffice 2018/3/7
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
Set xRg = Intersect(Range("D8:E100"), Target)
If xRg Is Nothing Then Exit Sub
If Target.Value = "pas fait" Then
Call EnvoiMail2
End If
End Sub


Sub EnvoiMail1()
Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String


        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)


        strbody = "<font size=""3"" face=""Calibri"">" & _
                  "Bonjour,<br><br>" & _
                  "Le remplacement de mélangeur <B> " & Cells(ActiveCell.Row, 3).Value & " </B>n'est pas fait Lundi Matin sur L2, merci d'en faire suite." & _
                  "<br><br>Cliquez sur ce lien pour ouvrir le fichier concerné : " & _
                  "<A HREF=""file://\\SERVEUR\Services\DCI\Service%20Informatique\Système%20et%20Réseau\Système\Documentation\" & Cells(ActiveCell.Row, 3).Value & ".docx" _
                  & """>ici</A>" & "<br><br>Cordialement," & _
                  "<br><br>Messsage automatique</font>"


        With OutMail
            .To = ""
            .CC = ""
            .BCC = ""
            .Subject = "MELANGEUR - remplacement nécessaire"
            .HTMLBody = strbody
            .Send
        End With
        On Error GoTo 0
        Set OutMail = Nothing
        Set OutApp = Nothing
End Sub

Sub EnvoiMail2()
Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String


        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)


        strbody = "<font size=""3"" face=""Calibri"">" & _
                  "Bonjour,<br><br>" & _
                  "Le remplacement de mélangeur <B> " & Cells(ActiveCell.Row, 3).Value & " </B>n'est pas fait Lundi Aprés -midi sur L7, merci d'en faire suite." & _
                  "<br><br>Cliquez sur ce lien pour ouvrir le fichier concerné : " & _
                  "<A HREF=""file://\\SERVEUR\Services\DCI\Service%20Informatique\Système%20et%20Réseau\Système\Documentation\" & Cells(ActiveCell.Row, 3).Value & ".docx" _
                  & """>ici</A>" & "<br><br>Cordialement," & _
                  "<br><br>Messsage automatique</font>"


        With OutMail
            .To = "r"
            .CC = ""
            .BCC = ""
            .Subject = "MELANGEUR - remplacement nécessaire"
            .HTMLBody = strbody
            .Send
        End With
        On Error GoTo 0
        Set OutMail = Nothing
        Set OutApp = Nothing
End Sub


Sub EnvoiMail3()
Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String


        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)


        strbody = "<font size=""3"" face=""Calibri"">" & _
                  "Bonjour,<br><br>" & _
                  "Le remplacement de mélangeur <B> " & Cells(ActiveCell.Row, 3).Value & " </B>n'est pas fait Lundi soir sur L8, merci d'en faire suite." & _
                  "<br><br>Cliquez sur ce lien pour ouvrir le fichier concerné : " & _
                  "<A HREF=""file://\\SERVEUR\Services\DCI\Service%20Informatique\Système%20et%20Réseau\Système\Documentation\" & Cells(ActiveCell.Row, 3).Value & ".docx" _
                  & """>ici</A>" & "<br><br>Cordialement," & _
                  "<br><br>Messsage automatique</font>"


        With OutMail
            .To = ""
            .CC = ""
            .BCC = ""
            .Subject = "MELANGEUR - remplacement nécessaire"
            .HTMLBody = strbody
            .Send
        End With
        On Error GoTo 0
        Set OutMail = Nothing
        Set OutApp = Nothing
End Sub


Sub EnvoiMail4()
Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String


        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)


        strbody = "<font size=""3"" face=""Calibri"">" & _
                  "Bonjour,<br><br>" & _
                  "Le remplacement de mélangeur <B> " & Cells(ActiveCell.Row, 3).Value & " </B>n'est pas fait Mardi Matin sur L4, merci d'en faire suite." & _
                  "<br><br>Cliquez sur ce lien pour ouvrir le fichier concerné : " & _
                  "<A HREF=""file://\\SERVEUR\Services\DCI\Service%20Informatique\Système%20et%20Réseau\Système\Documentation\" & Cells(ActiveCell.Row, 3).Value & ".docx" _
                  & """>ici</A>" & "<br><br>Cordialement," & _
                  "<br><br>Messsage automatique</font>"


        With OutMail
            .To = "r"
            .CC = ""
            .BCC = ""
            .Subject = "MELANGEUR - remplacement nécessaire"
            .HTMLBody = strbody
            .Send
        End With
        On Error GoTo 0
        Set OutMail = Nothing
        Set OutApp = Nothing
End Sub


Sub EnvoiMail5()
Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String


        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)


        strbody = "<font size=""3"" face=""Calibri"">" & _
                  "Bonjour,<br><br>" & _
                  "Le remplacement de mélangeur <B> " & Cells(ActiveCell.Row, 3).Value & " </B>n'est pas fait Mardi Aprés -midi sur L5/6, merci d'en faire suite." & _
                  "<br><br>Cliquez sur ce lien pour ouvrir le fichier concerné : " & _
                  "<A HREF=""file://\\SERVEUR\Services\DCI\Service%20Informatique\Système%20et%20Réseau\Système\Documentation\" & Cells(ActiveCell.Row, 3).Value & ".docx" _
                  & """>ici</A>" & "<br><br>Cordialement," & _
                  "<br><br>Messsage automatique</font>"


        With OutMail
            .To = ""
            .CC = ""
            .BCC = ""
            .Subject = "MELANGEUR - remplacement nécessaire"
            .HTMLBody = strbody
            .Send
        End With
        On Error GoTo 0
        Set OutMail = Nothing
        Set OutApp = Nothing
End Sub



Sub EnvoiMail6()
Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String


        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)


        strbody = "<font size=""3"" face=""Calibri"">" & _
                  "Bonjour,<br><br>" & _
                  "Le remplacement de mélangeur <B> " & Cells(ActiveCell.Row, 3).Value & " </B>n'est pas fait Mercredi matin sur L3, merci d'en faire suite." & _
                  "<br><br>Cliquez sur ce lien pour ouvrir le fichier concerné : " & _
                  "<A HREF=""file://\\SERVEUR\Services\DCI\Service%20Informatique\Système%20et%20Réseau\Système\Documentation\" & Cells(ActiveCell.Row, 3).Value & ".docx" _
                  & """>ici</A>" & "<br><br>Cordialement," & _
                  "<br><br>Messsage automatique</font>"


        With OutMail
            .To = "r"
            .CC = ""
            .BCC = ""
            .Subject = "MELANGEUR - remplacement nécessaire"
            .HTMLBody = strbody
            .Send
        End With
        On Error GoTo 0
        Set OutMail = Nothing
        Set OutApp = Nothing
End Sub

Sub EnvoiMail7()
Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String


        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)


        strbody = "<font size=""3"" face=""Calibri"">" & _
                  "Bonjour,<br><br>" & _
                  "Le remplacement de mélangeur <B> " & Cells(ActiveCell.Row, 3).Value & " </B>n'est pas fait Mercredi Soir/Nuit sur L8, merci d'en faire suite." & _
                  "<br><br>Cliquez sur ce lien pour ouvrir le fichier concerné : " & _
                  "<A HREF=""file://\\SERVEUR\Services\DCI\Service%20Informatique\Système%20et%20Réseau\Système\Documentation\" & Cells(ActiveCell.Row, 3).Value & ".docx" _
                  & """>ici</A>" & "<br><br>Cordialement," & _
                  "<br><br>Messsage automatique</font>"


        With OutMail
            .To = ""
            .CC = ""
            .BCC = ""
            .Subject = "MELANGEUR - remplacement nécessaire"
            .HTMLBody = strbody
            .Send
        End With
        On Error GoTo 0
        Set OutMail = Nothing
        Set OutApp = Nothing
End Sub

Sub EnvoiMail8()
Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String


        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)


        strbody = "<font size=""3"" face=""Calibri"">" & _
                  "Bonjour,<br><br>" & _
                  "Le remplacement de mélangeur <B> " & Cells(ActiveCell.Row, 3).Value & " </B>n'est pas fait Jeudi Matin sur L7, merci d'en faire suite." & _
                  "<br><br>Cliquez sur ce lien pour ouvrir le fichier concerné : " & _
                  "<A HREF=""file://\\SERVEUR\Services\DCI\Service%20Informatique\Système%20et%20Réseau\Système\Documentation\" & Cells(ActiveCell.Row, 3).Value & ".docx" _
                  & """>ici</A>" & "<br><br>Cordialement," & _
                  "<br><br>Messsage automatique</font>"


        With OutMail
            .To = ""
            .CC = ""
            .BCC = ""
            .Subject = "MELANGEUR - remplacement nécessaire"
            .HTMLBody = strbody
            .Send
        End With
        On Error GoTo 0
        Set OutMail = Nothing
        Set OutApp = Nothing
End Sub

Sub EnvoiMail9()
Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String


        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)


        strbody = "<font size=""3"" face=""Calibri"">" & _
                  "Bonjour,<br><br>" & _
                  "Le remplacement de mélangeur <B> " & Cells(ActiveCell.Row, 3).Value & " </B>n'est pas fait Jeudi Soir/ Nuit sur L5/6, merci d'en faire suite." & _
                  "<br><br>Cliquez sur ce lien pour ouvrir le fichier concerné : " & _
                  "<A HREF=""file://\\SERVEUR\Services\DCI\Service%20Informatique\Système%20et%20Réseau\Système\Documentation\" & Cells(ActiveCell.Row, 3).Value & ".docx" _
                  & """>ici</A>" & "<br><br>Cordialement," & _
                  "<br><br>Messsage automatique</font>"


        With OutMail
            .To = ""
            .CC = ""
            .BCC = ""
            .Subject = "MELANGEUR - remplacement nécessaire"
            .HTMLBody = strbody
            .Send
        End With
        On Error GoTo 0
        Set OutMail = Nothing
        Set OutApp = Nothing
End Sub

Sub EnvoiMail10()
Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String


        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)


        strbody = "<font size=""3"" face=""Calibri"">" & _
                  "Bonjour,<br><br>" & _
                  "Le remplacement de mélangeur <B> " & Cells(ActiveCell.Row, 3).Value & " </B>n'est pas fait Vendredi soir sur L3, merci d'en faire suite." & _
                  "<br><br>Cliquez sur ce lien pour ouvrir le fichier concerné : " & _
                  "<A HREF=""file://\\SERVEUR\Services\DCI\Service%20Informatique\Système%20et%20Réseau\Système\Documentation\" & Cells(ActiveCell.Row, 3).Value & ".docx" _
                  & """>ici</A>" & "<br><br>Cordialement," & _
                  "<br><br>Messsage automatique</font>"


        With OutMail
            .To = ""
            .CC = ""
            .BCC = ""
            .Subject = "MELANGEUR - remplacement nécessaire"
            .HTMLBody = strbody
            .Send
        End With
        On Error GoTo 0
        Set OutMail = Nothing
        Set OutApp = Nothing
End Sub

                  EDIT : Ajout des balises de code (la coloration syntaxique).
                  Explications disponibles ici : ICI

                  Merci d'y penser dans tes prochains messages.

                  cordialement
                  0
                  1. f894009
                    Re,
                    Ce qui change dans votre corps de message est ce qui se trouve dans le titre avec les jours ex: Lundi Matin(D5), la ligne L2 (D7)
                    Je ne comprends toujours pas pour la colonne E et les equivalentes

                    Donc une seule procedure d'envoi @Mail avec construction de la partie message differente en fonction de la colonne

                    Pourquoi un autre Pseudo????
                    0
                    1. barbarosilm
                      exactement ça""Donc une seule procedure d'envoi @Mail avec construction de la partie message differente en fonction de la colonne""
                      jai tellement des pseudo que j'oubliehhh
                      0
                      1. f894009
                        Re,

                        Vous ne repondez pas pour les colonnes E, G etc

                        exactement ça
                        Alors z'etes chaud bouillant pour faire(facile) ou vous passez la main
                        Si vous passez la main se sera demain matin possible
                        0
                        1. barbarosilm
                          oui pas de soussi pour demain
                          pour le colones F et G le meme code s'applique :(D8:E100) , (F8:G100) , (J8:K100), L8:M100)
                          N8:o100),(P8:Q100),R8::s100),(T8:V100,(V8:w100) chaque plage japplique le mem code pour appeller le mail par contre chaque plage a son propre mail
                          merci pour votre cooperation
                          0
                          1. f894009
                            Bonjour,

                            Ok, je regarde la chose

                            Vous ne repondez pas pour les colonnes E, G etc
                            Que saisissez vous dans ces colonnes(impaires) car "pas fait" ca n'a pas de sens!!!!!!!! 

                            Cells(ActiveCell.Row, 3).Value
                            , c'est quoi cette chose, y a rien dans la colonne C

                            Soussi, vous etes fan de foot, de Hanball ou autre personnage?
                            0
                            1. f894009
                              Suite:

                              Pour moi LIGNE/QUAND sont liees, donc ex: D8 et E8 doivent etre fusionnees pour avoir une seule saisie

                              You pige?
                              0
                          2. barbarosilm Auteur
                            bonjour
                            quand on fusionne deux cellules o peut attribuer un code ,si oui de coup je fusionne les cellules ca me convient
                            le E et G et les autres c'est des plage de cellules ou on peut ecrire "pas fait"
                            j'espère que j'étais claire
                            mon but c'est quand on ecrit" pas fait" dans une plage des cellules qui corespond à un jour de semaine un mail doit etre générer automatiquement suivant la ligne et le jour de la semaine qui corespond
                            0
                            1. f894009
                              Re, 

                              Cells(ActiveCell.Row, 3).Value
                              , c'est quoi cette chose, y a rien dans la colonne C

                              Ok pour fussion
                              0
                              1. barbarosilm Auteur
                                Re je sait pas hh ce code je l'est chopé sur net et aprés j'ai adapter a mon tableau
                                c'est dans le corps de mail
                                vous avez pas trouvez une solution ?
                                0
                                1. barbarosilm Auteur
                                  On peut pas utiliser "" Application.EnableEvents = False"" pour faire le meme code avec worksheet change ? car j'ai besoin de repeter 10 fois le code mais avec "worksheet change " je peut pas
                                  0
                                  1. f894009
                                    Bonjour,
                                    Re je sait pas hh ce code je l'est chopé
                                    Ben, a l'avenir faites attention que le code que vous "chopez" ne vous foute pas la zone sur votre PC

                                    besoin de repeter 10 fois le code mais avec "worksheet change " je peut pas
                                    Evitez donc de prendre le nom de procedure pour autre chose que ce dont elles sont faites.

                                    repeter 10 fois le code
                                    Pourquoi 10 fois?

                                    Vous voulez que la procedure de verif parcoure toutes les cellules du tableau et envoi un @mail pour les cellules avec pas fait?
                                    Comment la procedure sera lancee?
                                    Faudra eviter d'envoyer un @mail a chaque fois que le code sera lance pour les cellules deja concernees le tour precedent
                                    0
                                    1. barbarosilm Auteur
                                      bonjour
                                      avez vous une suggestion?
                                      "Vous voulez que la procedure de verif parcoure toutes les cellules du tableau et envoi un @mail pour les cellules avec pas fait?"
                                      oui exactement ca? chaque plage de cellule un mail different
                                      0
                                      • 1
                                      • 2

                                      Discussions similaires

                                      'Votre colis est dans le site de livraison qui dessert votre adresse' que faire
                                      relakztek82

                                      25 réponses
                                      Echec d'envoi message sur Messenger
                                      Kris68

                                      2 réponses