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

Fermé

Ray - 24 nov. 2016 à 15:55
yg_be Messages postés 23480 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 3 mars 2025 - 28 nov. 2016 à 20:48

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)

A voir également:

VBA envoie par courriel si un (X) est sélectionné dans la colone
Cci courriel - Guide
Classer par ordre alphabétique excel plusieurs colonnes - Guide
Dans ce fichier, réalisez le graphique xy (nuage de points ou dispersion), avec les x en abscisse. dans le graphique, les points dessinent un nombre. lequel ? - Forum Bureautique
Ajoutez à la liste de contacts ana le goff, inscrite le 27 novembre 2015, dans la catégorie i. puis triez les contacts en les classant : par ordre alphabétique de leur nom de famille (critère principal), puis par date du plus récent au plus ancien (critère secondaire). quel mot apparaît à la verticale dans la colonne "catégorie" entre les lignes 200 et 209 (en-tête compris) ? ✓ - Forum Word
Nouvelle partie pokemon x ✓ - Forum DS

3 réponses

Réponse 1 / 3

ray
26 nov. 2016 à 18:34

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

f894009 Messages postés 17241 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 19 février 2025 1 713
26 nov. 2016 à 18:47

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

ray
28 nov. 2016 à 15:20

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

f894009 Messages postés 17241 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 19 février 2025 1 713 > ray
Modifié par f894009 le 28/11/2016 à 19:03

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

ray > f894009 Messages postés 17241 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 19 février 2025
28 nov. 2016 à 20:28

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)

yg_be Messages postés 23480 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 3 mars 2025 1 568
28 nov. 2016 à 20:48

Peut-être exécuter le code pas à pas, en mettant un point d'arrêt tout au début?

Réponse 2 / 3

f894009 Messages postés 17241 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 19 février 2025 1 713
26 nov. 2016 à 08:03

Bonjour,
Avec ou sans Outlook?

Réponse 3 / 3

ray
26 nov. 2016 à 15:28

avec Outlook

Merci

f894009 Messages postés 17241 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 19 février 2025 1 713
26 nov. 2016 à 18:29

Re,

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

Discussions similaires

Dimensions L x l x H : comment lire ces infos ?

Tri les lettres d'un mot par ordre alphabétique

Vérité ou mensonge sur américan history x 2

manon

Sauvegegarder le document avec un nom trouvé dans ce doc