Envoi mail Macro excel

Bonjour,

Je souhaiterai créer une alerte sur mon fichier excel de sorte que lorsqu'une note est différente de 0, un mail est envoyé à des destinataires.
J'ai deux macro qui fonctionnent indépendamment l'une de l'autre mais je n'arrive pas à les lier.

Ci-dessous les macros :

'Envoi de mail personnalisés d'une liste excel via outlook

Public Sub EnvoiAutomatiqueMail()
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim adresse As String
Dim message As String
Dim sujet As String

sujet = "Macro QSE Achats!!!!"
For i = 2 To 3
adresse = Range("c" & i)
message = Range("d" & i) & vbCrLf & "Je fais le test macro dis moi si ca fonctionne"

Set OutlookApp = CreateObject("outlook.application")
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.Subject = sujet
.To = adresse
.Body = message
.Send
End With

Next i

End Sub

Sub Macro5()

Sheets("Feuil1").Select
Cells(1, 1).Select
If ActiveCell.Value > 0 Then
ActiveWorkbook.SendMail ("adresse mail")

End If

End Sub

Pouvez-vous m'aider.

Merci par avance pour votre aide !

JM

3 réponses

  1. Bonjour,

    La macro doit se lancer lorsque la note qui se trouve en m8 est inférieure à 92.

    Merci,

    Jean-Marie
    1. Bonjour,

      a mettre dans le VBA de la feuille de saisie:

      Private Sub Worksheet_Change(ByVal Target As Range)
      Dim OutlookApp As Object
      Dim OutlookMail As Object
      Dim adresse As String
      Dim message As String
      Dim sujet As String

      If Not Application.Intersect(Target, Range("M:M")) Is Nothing And Target.Count = 1 And (Target < 92 And Target > 0) Then
      sujet = "Macro QSE Achats!!!!"
      For i = 2 To 3
      adresse = Range("c" & i)
      message = Range("d" & i) & vbCrLf & "Je fais le test macro dis moi si ca fonctionne"
      Set OutlookApp = CreateObject("outlook.application")
      Set OutlookMail = OutlookApp.CreateItem(0)
      With OutlookMail
      .Subject = sujet
      .To = adresse
      .Body = message
      .Send
      End With
      Set OutlookApp = Nothing
      Set OutlookMail = Nothing
      Next i
      End If
      End Sub