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

Ray -
yg_be Messages postés 23541 Date d'inscription Statut Contributeur Dernière intervention - 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
Site x - Guide
Sites X : Pornhub, YouPorn et Redtube sont de nouveau accessibles en France - Guide
Cci courriel - Guide
Classer par ordre alphabétique excel plusieurs colonnes - Guide
Photoscape x - Télécharger - Retouche d'image

3 réponses

Réponse 1 / 3

ray

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 17277 Date d'inscription Statut Membre Dernière intervention 1 713

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

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 17277 Date d'inscription Statut Membre Dernière intervention 1 713 > 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

ray > f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention

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 23541 Date d'inscription Statut Contributeur Dernière intervention 1 584

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 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Bonjour,
Avec ou sans Outlook?

Réponse 3 / 3

ray

avec Outlook

Merci

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

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

Envoie impossible messenger

Votre réponse

Discussions similaires