VBA envoie par courriel si un (X) est sélectionné dans la colone [Fermé]

Signaler
-
Messages postés
15063
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
10 avril 2021
-
Bonjour,

J'ai besoin que si une cellule de la colone b contient (x) j'ai un message qui s'affiche et la personne sélectionne oui, ceci envoie une message par courriel. (VBA)


3 réponses

on sélectionne un numero de formule dans une liste déroulante depuis un combobox installer dans une feuille et si la formule corespond a exemple 'c2285' alors le message affiche. j'ai une formule a choisir par ligne
1
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 65492 internautes nous ont dit merci ce mois-ci

Messages postés
15723
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
10 avril 2021
1 481
Re,

Entre votre demande du depart et votre deuxieme demande, y a quand meme une belle difference. Donc je vous mets un code qui boucle sur une plage de cellules (premiere demande) et vous adapterez

Sub Envoi_EMail_Auto()
    On Error Resume Next
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim L As Integer 'Déclaration de variable "L" pour connaitre la Ligne Numéro
    Dim Plage_DL As Range
    Dim cel As Range

    'mise en memoire plage de donnees colonne A
    With Worksheets("feuil1")
        L = .Range("A" & Rows.Count).End(xlUp).Row
        Set Plage_DL = .Range("A2:A" & L)
    End With
    'boucle plage
    For Each cel In Plage_DL
        If UCase(cel) = "X" Then
            retval = MsgBox("Envoi @Mail ??", vbYesNo)
            If retval = vbYes Then
                Set OutApp = CreateObject("Outlook.Application")
                Set OutMail = OutApp.CreateItem(0)
                Contenu = ""
                'contenu message a adapter
                Contenu = "contenu message a adapter"
                strbody = Contenu
                With OutMail
                    .To = "xxxxxxxxxxx@xxx.xxx"     'adresse destinataire
                    .CC = ""          ' adresse a mettre si copie
                    .BCC = ""
                    .Subject = "objet du message"
                    .Body = strbody
                    'You can add a file like this
                    '.Attachments.Add ("C:\test.txt")
                    '.Display       'ouverture de Outlook et clic sur envoyer
                    'or use
                    .Send       'envoi direct sans ouvrir Outlook
                End With
            End If
        End If
        'attente envoi @Mail par Outlook
        'Application.Wait Application.Wait(Now + TimeValue("0:00:01"))
        Set OutMail = Nothing
        Set OutApp = Nothing
    Next
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
Voici le code jusqu'a maintenant. Par contre il ne fonctionne pas lorsque je change ma donnée dans ma cellule.

???????


Sub Envoi_EMail_Auto()
On Error Resume Next
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim L As Integer 'Déclaration de variable "L" pour connaitre la Ligne Numéro
Dim Plage_DL As Range
Dim cel As Range

'mise en memoire plage de donnees colonne C
With Worksheets("activesheet")
L = .Range("C" & Rows.Count).End(xlUp).Row
Set Plage_DL = .Range("C7:C162" & L) ' La colonne
End With
'boucle plage
For Each cel In Plage_DL
If UCase(cel) = "C2285" Then
If UCase(cel) = "C2206" Then
If UCase(cel) = "C2414" Then
If UCase(cel) = "C5862" Then
If UCase(cel) = "C8979" Then
If UCase(cel) = "C9771" Then
If UCase(cel) = "C9762" Then
If UCase(cel) = "C9761" Then
If UCase(cel) = "C9773" Then
If UCase(cel) = "C9774" Then
If UCase(cel) = "C9760" Then
If UCase(cel) = "C9772" Then
If UCase(cel) = "C9988" Then
If UCase(cel) = "C10143" Then
If UCase(cel) = "C10143/3" Then
retval = MsgBox("Ceci est une formulation DIN, voulez-vous envoyer une confirmation ?", vbYesNo)
If retval = vbYes Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Contenu = ""
'contenu message a adapter
Contenu = "Formulation DIN en cours dans la station :" & vbNewLine & (Sheet1.Cells(7, 1)) & vbNewLine & (Sheet1.Cells(7, 3)) & vbNewLine & (Sheet1.Cells(7, 4)) & vbNewLine & (Sheet1.Cells(7, 5))
strbody = Contenu
With OutMail
.To = "test.com;"
.CC = ""
.BCC = ""
.Subject = "Test d'envoi pour les formulations DIN"
.Body = strbody
'You can add a file like this
'.Attachments.Add ("C:\test.txt")
'.Display 'ouverture de Outlook et clic sur envoyer
'or use
.Display 'envoi direct sans ouvrir Outlook
End With
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
'attente envoi @Mail par Outlook
'Application.Wait Application.Wait(Now + TimeValue("0:00:01"))
Set OutMail = Nothing
Set OutApp = Nothing
Next
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Messages postés
15723
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
10 avril 2021
1 481 > ray
Bonjour,

Par contre il ne fonctionne pas lorsque je change ma donnée dans ma cellule.
Je dirai meme qu'il ne marche pas du tout, car pas fait pour et la paillassee de if then ne sert a rien sauf a semer la zizanie

Vous voulez envoyer un @Mail sur changement de valeur d'une cellule colonne C et si elle est egale a une des conditions (Cxxx) precisees dans votre code ?

Si oui, code a mettre dans VBA de la feuille
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim L As Integer
    
    If Target.Count > 1 Then Exit Sub
    L = Range("C" & Rows.Count).End(xlUp).Row
    If Not Intersect(Target, Range("C7:C" & L)) Is Nothing Then
        CelTst = UCase(Target)
        If CelTst = "C2285" Or CelTst = "C2206" Or _
            CelTst = "C2414" Or CelTst = "C5862" Or _
            CelTst = "C8979" Or CelTst = "C9771" Or _
            CelTst = "C9762" Or CelTst = "C9761" Or _
            CelTst = "C9773" Or CelTst = "C9774" Or _
            CelTst = "C9760" Or CelTst = "C9772" Or _
            CelTst = "C9988" Or CelTst = "C10143" Or _
            CelTst = "C10143/3" Then
            retval = MsgBox("Ceci est une formulation DIN, voulez-vous envoyer une confirmation ?", vbYesNo)
            If retval = vbYes Then
                Set OutApp = CreateObject("Outlook.Application")
                Set OutMail = OutApp.CreateItem(0)
                Contenu = ""
                'contenu message a adapter
                Contenu = "Formulation DIN en cours dans la station :" & vbNewLine & (Sheet1.Cells(7, 1)) & vbNewLine & (Sheet1.Cells(7, 3)) & vbNewLine & (Sheet1.Cells(7, 4)) & vbNewLine & (Sheet1.Cells(7, 5))
                strbody = Contenu
                With OutMail
                    .To = "test.com;"
                    .CC = ""
                    .BCC = ""
                    .Subject = "Test d'envoi pour les formulations DIN"
                    .Body = strbody
                    'You can add a file like this
                    '.Attachments.Add ("C:\test.txt")
                    '.Display 'ouverture de Outlook et clic sur envoyer
                    'or use
                    .Display 'envoi direct sans ouvrir Outlook
                End With
            End If
        End If
        'attente envoi @Mail par Outlook
        'Application.Wait Application.Wait(Now + TimeValue("0:00:01"))
        Set OutMail = Nothing
        Set OutApp = Nothing
        On Error GoTo 0
        Set OutMail = Nothing
        Set OutApp = Nothing
    End If
End Sub
>
Messages postés
15723
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
10 avril 2021

Pour une raison inconnue et je m'en excuse, le code ne démarre pas. Je sais pas si c'est moi ;) possible, mais mes autres codes fonctionnent bien. Je l'ai mis sur ma feuille principal (Sheet1)
Messages postés
15063
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
10 avril 2021
827
Peut-être exécuter le code pas à pas, en mettant un point d'arrêt tout au début?
Messages postés
15723
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
10 avril 2021
1 481
Bonjour,
Avec ou sans Outlook?
avec Outlook

Merci
Messages postés
15723
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
10 avril 2021
1 481
Re,

Petit details:
_ce x arrive comment et une seule cellule ou plusieurs
_a quel moment doit - on regarder cette ou ces cellules ???