Macro envoie mail visual basic

Bonjour,
Actuellement étudiante, je débute dans la programmation Visual Basic. Pour un projet que je dois réaliser, l'utilisation de macros est nécessaire. Ne connaissant pas Visual Basic je me tourne vers vous pour trouver de l'aide. Dans mon tableau excel, j'ai appliqué des mises en formes conditionnelles à certaines cellules ( certaines se colorient en vert, rouge, noir ou bien jaune ). Je voudrais qu'un mail s'envoit dès lors qu'une des cellules de mon tableau se colore. Ce mail doit m'informer de la ou les cellules ciblées par le changement de couleur.
Merci par avance pour votre aide.

9 réponses

  1. bonjour si tu as des suites je suis preneur, j'ai exactement le même soucis que toi et je suis très débutant en VB.

    Merci d'avance a tous.
    1. Modérateur
      Bonjour,
      Il te faut déjà prendre le problème par "le bon bout".
      Si tu cherches à capter l'événement "changement de couleur par MFC" tu va tomber sur un sacré os en programmation... Non? Attention, je ne dis pas que c'est infaisable, je dis juste qu'il y a plus simple.

      Qui dit Mise en Forme Conditionnelle (MFC) dit condition(s) qui la déclenche(nt). C'est cette condition que tu dois exprimer en VBA pour lancer la procédure d'envoi de mail.

      Tu dis...
      1. Bonjour,
        Tout d'abord merci pour votre réponse.
        J'ai plusieurs mises en forme conditionnelle :
        - la première : se déclenche si l'une des cases des colonnes de stock est égale à un
        - la deuxième : se déclenche si l'une des cases de la colonne date de péremption contient une date se produisant la semaine prochaine
        - la troisième : se déclenche si l'une des cates de la colonne date de péremption contient une date se produisant cette semaine
        - la quatrième : se déclenche si l'une des cases de la colonne date de péremption contient une date qui est dépassée
        Ce sont ces mises en formes conditionnelles que je dois exprimer en VBA.
        Pouvez-vous m'aider?
    2. Modérateur
      Bonjour,
      dernière question :
      j'ai appliqué des mises en formes conditionnelles à certaines cellules Celles ci se déclenchent après saisie dans d'autres cellules je suppose. Si oui lesquelles? Sinon comment (quel événement) se déclenchent les MFC?
      1. Modérateur
        Condition 4 : se déclenche si l'une des cases de la colonne date de péremption contient une date qui est dépassée Que se passe t'il si une date appartient à cette semaine mais qu'elle est dépassée? Condition 3 ou condition 4???
    3. Modérateur
      Dans l'attente des réponses...
      J'ai considéré que :
      - Colonne Stock = colonne A
      - Colonne Dates = Colonne B
      - Si date dépassée même si elle est de cette semaine alors condition 4

      Dans cette macro, les conditions sont exprimées par des messages à l'utilisateur. Il conviendra de remplacer ces MsgBox par des envois de mail.

      Cette procédure est largement commentée pour que vous saisissiez bien tout. Le cas contraire ne pas hésiter.

      J'utilise la fonction num_sem de Laurent Longre, pour être sur de ne pas se tromper...

      Voici un classeur exemple c'est cadeau, si si ça fait plaisir...
      Pour l'instant, on déclenche la macro par ALT+F8. Par la suite, après réponse à mon commentaire ci dessus, on fera en sorte qu'elle se déclenche automatiquement...

      Le code commenté :
      Option Explicit
      
      Sub Conditions()
      'Déclaration des variables
          'Lig est la variable pour boucler sur les lignes
          'DernLig représentera le n° de la dernière ligne remplie
          'Déclarées au type Long car :
          'ceux sont des variables de type numériques (n° de ligne) entiers
          'Comme Integer et Long occupent aujourd'hui autant d'espace mémoire
          'autant tout de suite prévoir pour des longs longs tableaux...
              'pour info : Integer = Nbre entier entre -32 768 et 32 767
              '            Long = Nbre entier entre -2 147 483 648 et 2 147 483 647
      Dim Lig As Long, DernLigColA As Long, DernLigColB As Long
      'Deux variables de type tableau (noter la présence des () qui nous l'indique)
      'le premier TablStock pour les données de la colonne A qui sont des nombres entiers
      Dim TablStock() As Long
      'le second TablDates pour les données de la colonne B qui sont des dates
      Dim TablDates() As Date
      
      '------ RECUPERATION DES DONNEES -------
      'Ici on va travailler dans la feuille Feuil1
      With Sheets("Feuil1") ' A adapter le nom de la feuille
      'Au préalable, il nous faut définir la taille des variables tableaux.
          'ces deux variables sont censées stocker x données
          'x étant le nombre de lignes occupées par ces données
          'on obtient x en faisant l'opération : Dernière Ligne - 1 (la première ligne comprenant des entêtes)
      '--- Redimensionnement des variables tableaux ---
          '(calcul du nombre d'éléments composant chaque var tableau)
          '- de TablStock
          DernLigColA = .Range("A" & Rows.Count).End(xlUp).Row - 1
              'A noter dans un bloc With - End With la présence du point
              'devant les objets Range, Cell etc...
          ReDim TablStock(DernLigColA - 1) 'A noter - 1 car les tableaux commencent, par défaut, à l'indice 0
          '- de TablDates
          DernLigColB = .Range("B" & Rows.Count).End(xlUp).Row - 1
          ReDim TablDates(DernLigColB - 1)
      '--- Remplissage des variables tableaux ---
          For Lig = 0 To UBound(TablStock)
              TablStock(Lig) = .Cells(Lig + 2, 1)
          Next
          For Lig = 0 To UBound(TablDates)
              TablDates(Lig) = .Cells(Lig + 2, 2)
          Next
      '------ CONDITIONS - TESTS DES DONNEES RECUPEREES -----
      '--- Condition 1
      'se déclenche si l'une des cases des colonnes de stock est égale à un
      'Comme une seule condition appliquée à la colonne A on va utiliser un If - Enf If
          'Boucle sur les données du TablStock
          For Lig = 0 To UBound(TablStock)
              'Si cette donnée est égale à 1 alors...
              If TablStock(Lig) = 1 Then
                  'Ici on enverra un nimèle... Pour l'instant, message à l'utilisateur
                  MsgBox "Valeur 1 trouvée en cellule A" & Lig + 2
              End If
          Next
      'Comme plusieurs conditions appliquées à la colonne B on va utiliser un Select Case
          'Boucle sur les données du TablDates
          For Lig = 0 To UBound(TablDates)
              'premier test Si la date est "périmée" alors condition 4 sinon on teste
              'pour les conditions 2 et 3
              If TablDates(Lig) < CDate(Date) Then
                  MsgBox "La date contenue en B" & Lig + 2 & " est périmée."
              Else
              'ici on va appeler le N° de semaine de la date stockée
              'cf la fonction num_sem en dessous de cette Sub...
                  Select Case num_sem(TablDates(Lig))
      '--- Condition 2
      'se déclenche si l'une des cases de la colonne date de péremption
      'contient une date se produisant la semaine prochaine
                      Case num_sem(Date) + 1
                          MsgBox "La date contenue en B" & Lig + 2 & " se produit la semaine prochaine."
      '--- Condition 3
      'se déclenche si l'une des cates de la colonne date de péremption
      'contient une date se produisant cette semaine
                      Case num_sem(Date)
                          MsgBox "La date contenue en B" & Lig + 2 & " se produit cette semaine."
                  End Select
              End If
          Next
      End With
      End Sub
      
      Function num_sem(D As Date) As Long
      'Auteur: Laurent Longre. X-Cell
      'La fonction suivante renvoie le numéro de semaine conforme à la norme ISO,
      'utilisée dans les pays européens (la première semaine d'un mois étant définie
      'comme la première semaine comportant au moins quatre jours dans le mois).
      
      D = Int(D)
      num_sem = DateSerial(Year(D + (8 - Weekday(D)) Mod 7 - 3), 1, 1)
      num_sem = ((D - num_sem - 3 + (Weekday(num_sem) + 1) Mod 7)) \ 7 + 1
      End Function

      Testez et revenez........
      1. Bonjour,
        Maintenant que j'ai réussi a appliquer et utiliser le programme sur mon tableur comme je voulais je voudrais que les message box soient remplacés par des email et si possible envoyé au mail écrit dans une cellule pour pouvoir le changer cela est-il possible?
        Voici le tableur avec le programme https://www.cjoint.com/?ALgvdTBqM7k
      2. Modérateur
        Bonjour,
        1- je ne lis pas les fichiers .xlsm avec mon vieux excel 2003. Merci de joindre un fichier .xls (enregistrer sous/type : Excel97-2003).
        2-
        je voudrais que les message box soient remplacés par des email 
        Quel logiciel de messagerie utiliserez vous? (Lotus, Outlook, autre...)
        3- Je ne me souvient plus les conditions d'envoi du mail, si vous pouviez me rafraichir la mémoire...
      3. Bonjour,
        Voici le nouveau lien https://www.cjoint.com/?ALhmWjzcWkB
        J'utilise outlook comme messagerie.
        Pour les conditions :
        Condition 1 se déclenche si l'une des cases des colonnes de stock est égale à un
        Condition 2 se déclenche si l'une des cases de la colonne date de péremption contient une date se produisant la semaine prochaine
        Condition 3 se déclenche si l'une des cates de la colonne date de péremption contient une date se produisant cette semaine
        Condition 4 se déclenche si l'une des cases de la colonne date de péremption contient une date "périmée"
        En premier on teste la condition 4 sinon on teste la condition 2 et 3
    4. Contributeur
      Bonjour, bonjour Pijaku,
      Une autre approche ?
      coller cette fonction dans un module
      Et dans une colonne mettre les appels sous forme de
      =CouleurMFC(CelluleQuiChange)
      Et intercaler dans le code
                      'Peu ajouter d'autre format si nécessaire, 
                      'comme la bordure, la police etc.. 
                      Select Case Mode 
                      Case 0 
                          CouleurMFC = LoMFC.Interior.ColorIndex 
                      Case 1 
                          CouleurMFC = LoMFC.Interior.Color 
                      End Select 
                      if Application.Caller.Interior.ColorIndex <> 2 'par exemple 
                          If CouleurMFC = CouleurSouhaitée then  
                                Envoyer mail 
      'Eviter d'envoyer plusieurs mail 
                                Application.Caller.Interior.ColorIndex = 2   
                         end if 
                     end if 
      

      Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)
      NOTE : Je ne répond pas aux MP pour les questions techniques.
      1. Bonjour,
        Merci de prendre de votre temps, cela m'aide énormément. Pour répondre à vos questions, voici ci-joint un tableau qui aidera à me faire comprendre.
        https://www.cjoint.com/?0KjsvSyLtu7
        Les MFC concernant la date de péremption se déclenchent après saisie dans ces mêmes cellules. En revanche, les MFC concernant le stock se déclenchent après saisie dans les colonnes "Entrée" ou "Sortie".
        Si une date appartient à cette semaine mais qu'elle est dépassée alors condition 4. J'ai testé votre programme, la procédure détaillée m'aide beaucoup dans la compréhension de celui-ci, encore une fois merci. J'espère que mes réponses sont assez précises. La macro peut elle être déclenchée automatiquement ?
        Merci de votre aide.
        1. Contributeur
          Mais C'EST automatique, c'est comme une formulle SOMME ou SI etc..
          A+
          1. Modérateur
            RE-

            !!!!!! Pour utiliser Outlook depuis excel, il faut cocher la référence à cette application !!!!!
            Pour cela:
            Sous VBE : Outils/Références, chercher puis cocher :
            Microsoft Outlook xx.x Object Library (xx dépends de ta version d'Office)

            Je ne dispose pas d'Outlook, donc :
            - je n'ai pas coché cette référence dans le fichier exemple,
            - je n'ai pas pu tester...

            Le classeur exemple.

            Le code (j'ai viré les commentaires car ça fait long...) :
            Option Explicit
            
            Sub Conditions()
            Dim Lig As Long, DernLigColF As Long, DernLigColB As Long
            Dim TablStock() As Long
            Dim TablDates() As Date
            Dim Message As String
            
            With Sheets("Feuil1")
                DernLigColF = .Range("F" & Rows.Count).End(xlUp).Row - 1
                ReDim TablStock(DernLigColF - 1)
                DernLigColB = .Range("B" & Rows.Count).End(xlUp).Row - 1
                ReDim TablDates(DernLigColB - 1)
                For Lig = 0 To UBound(TablStock)
                    TablStock(Lig) = .Cells(Lig + 2, 6)
                Next
                For Lig = 0 To UBound(TablDates)
                    TablDates(Lig) = .Cells(Lig + 2, 2)
                Next
                For Lig = 0 To UBound(TablStock)
                    If TablStock(Lig) = 1 Then
                        Message = Message & .Cells(Lig + 2, 1) & " Stock = 1!" & Chr(10)
                    End If
                Next
                For Lig = 0 To UBound(TablDates)
                    If TablDates(Lig) < CDate(Date) Then
                        Message = Message & "La date contenue en B" & Lig + 2 & " est périmée." & Chr(10)
                    Else
                        Select Case num_sem(TablDates(Lig))
                            Case num_sem(Date) + 1
                                Message = Message & "La date contenue en B" & Lig + 2 & " se produit la semaine prochaine." & Chr(10)
                            Case num_sem(Date)
                                Message = Message & "La date contenue en B" & Lig + 2 & " se produit cette semaine." & Chr(10)
                        End Select
                    End If
                Next
            End With
                If Message <> "" Then EnvoiMail Message
            End Sub
            
            Function num_sem(D As Date) As Long
            D = Int(D)
            num_sem = DateSerial(Year(D + (8 - Weekday(D)) Mod 7 - 3), 1, 1)
            num_sem = ((D - num_sem - 3 + (Weekday(num_sem) + 1) Mod 7)) \ 7 + 1
            End Function
            
            Sub EnvoiMail(Message As String)
            Dim Ol As New Outlook.Application
            Dim OlMail As MailItem
            Dim CurrFile As String
            
            Set Ol = New Outlook.Application
            Set OlMail = Ol.CreateItem(OlMailItem)
            With OlMail
               .To = Sheets("Feuil1").Range("K3").Value
               .Subject = "Alerte date de péremtion"
               .Body = Message
               .Send
            End With
            End Sub

            Testes et dis nous...
            1. J'ai testé et ça marche je reçois un mail quand je déclenche la macro par contre j'ai deux questions :
              - pour le stock c'est bon il me met kit A stock=1 par contre pour la péremption il me met "la date contenue en B2 se produit la semaine prochaine" est-ce qu'on pourrait mettre à la place comme pour le stock "le kit a une date se produisant la semaine prochaine
              - quand je le reçoit ça va dans ma boîte d'envoi et non dans ma boîte de réception est-ce normal?
            2. Modérateur
              Bonjour,
              est-ce qu'on pourrait mettre à la place comme pour le stock "le kit a une date se produisant la semaine prochaine
              Dans la macro, au fur et à mesure de son exécution, tu as des lignes de code qui remplissent la variable Message. Cette variable est utilisée dans le corps du mail envoyé.
              Pour changer ce message, tu repères ces 3 lignes :
              Message = Message & "La date contenue en B" & Lig + 2 & " est périmée." & Chr(10)
              Message = Message & "La date contenue en B" & Lig + 2 & " se produit la semaine prochaine." & Chr(10)
              Message = Message & "La date contenue en B" & Lig + 2 & " se produit cette semaine." & Chr(10)
              et tu les remplaces respectivement par :
              Message = Message & .Cells(Lig +  2, 1) & " a une date périmée." & Chr(10)
              Message = Message & .Cells(Lig +  2, 1) & " a une date qui se produit la semaine prochaine." & Chr(10)
              Message = Message & .Cells(Lig +  2, 1) & " a une date qui se produit cette semaine." & Chr(10)


              quand je le reçoit ça va dans ma boîte d'envoi et non dans ma boîte de réception est-ce normal?
              Je dirais non. Mais ne pouvant pas tester et n'y connaissant pas grand chose, je ne peux rien pour ça. Je dirais donc 2 choses : "le pricipal c'est de voir ce mail." "Si tu souhaites aller au fond des choses, refais un nouveau sujet intitulé : VBA envoi mail réception dans boite d'envoi:"...
            3. Contributeur
              Evidemment que c'est normal, c'est l'appli qui envoi le mail mais c'est comme si c'était toi.
              Donc.. dans la boite d'envoi.
              Et le PC dont l'adresse mail est dans 'Sheets("Feuil1").Range("K3").Value' l'a dans sa boite de réception.
            4. Merci oui c'est super que le mail fonctionne. J'aurai une autre question là je déclenche manuellement la macro serait-il possible qu'elle se déclenche toute seule sans cocher sur macro exécuter?
              Et encore merci beaucoup de m'aider autant.
            5. Modérateur
              serait-il possible qu'elle se déclenche toute seule sans cocher sur macro exécuter?
              Oui en suivant la méthode décrite par Lermitte222 en date du 09/11/2011 à 09h21..........
          2. Contributeur
            Non, la solution que j'ai proposée demanderait trop de cellules et trop de temps.
            La solution serait de garder le système de Pijaku et de faire un scanning tout les xx temps suivant le rythme des modifications, si c'est par date une ou deux fois par jour suffirait.
            Marche à suivre,
            Private Sub Workbook_Open()
                ExectueMacro
            End Sub

            et dans un module
            Sub ExectueMacro()
                'Par exemple toute les 10 heures
                Application.OnTime Now + TimeValue("10:00:00"), "ExectueMacro"
                Call Conditions()
            End Sub

            Exécutera la macro à l'ouverture du classeur et ensuite toutes les dix heures (dans mon exemple)
            A+
            1. Contributeur
              Ou si le PC est allumé en permanence,
              remplacer la ligne..
              Application.OnTime Now + TimeValue("10:00:00"), "ExectueMacro"
              'PAR
              Application.OnTime  TimeValue("00:01:00"), "ExectueMacro"

              Exécutera la macro à l'ouverture du classeur et ensuite tout les jours à 0Hr 1 minute
              A toi de voir ce qui convient le mieux.