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

  • Votes
  • Date
  • Date décroissante
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.  f894009
      Bonjour,

      sur vba j'ai un souci
      Vous connaissez la programmation VBA ?
      2. 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
        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
          2. 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?
            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
              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????
                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
                  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
                    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
                      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?
                        1. f894009
                          Suite:

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

                          You pige?
                      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
                        1. f894009
                          Re, 

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

                          Ok pour fussion
                          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 ?
                            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
                              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
                                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
                                  • 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