Note: The other languages of the website are Google-translated. Back to English
English English

Comment envoyer automatiquement un e-mail en fonction de la valeur de la cellule dans Excel?

Supposons que vous souhaitiez envoyer un e-mail via Outlook à un certain destinataire en fonction d'une valeur de cellule spécifiée dans Excel. Par exemple, lorsque la valeur de la cellule D7 dans une feuille de calcul est supérieure à 200, un e-mail est créé automatiquement. Cet article présente une méthode VBA pour vous permettre de résoudre rapidement ce problème.

Envoyez automatiquement un e-mail en fonction de la valeur de la cellule avec le code VBA


Envoyez automatiquement un e-mail en fonction de la valeur de la cellule avec le code VBA

Veuillez procéder comme suit pour envoyer un e-mail basé sur la valeur de la cellule dans Excel.

1. Dans la feuille de calcul, vous devez envoyer un e-mail en fonction de la valeur de sa cellule (ici indique la cellule D7), cliquez avec le bouton droit sur l'onglet de la feuille et sélectionnez Voir le code dans le menu contextuel. Voir la capture d'écran:

2. Dans le pop-up Microsoft Visual Basic pour applications , veuillez copier et coller le code VBA ci-dessous dans la fenêtre de code de la feuille.

Code VBA: envoyer un e-mail via Outlook en fonction de la valeur de la cellule dans Excel

Dim xRg As Range
'Update by Extendoffice 2018/3/7
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Cells.Count > 1 Then Exit Sub
  Set xRg = Intersect(Range("D7"), Target)
    If xRg Is Nothing Then Exit Sub
    If IsNumeric(Target.Value) And Target.Value > 200 Then
        Call Mail_small_Text_Outlook
    End If
End Sub
Sub Mail_small_Text_Outlook()
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hi there" & vbNewLine & vbNewLine & _
              "This is line 1" & vbNewLine & _
              "This is line 2"
    On Error Resume Next
    With xOutMail
        .To = "Email Address"
        .CC = ""
        .BCC = ""
        .Subject = "send by cell value test"
        .Body = xMailBody
        .Display   'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

Notes:

1). Dans le code VBA, D7 et des tours valeur> 200 sont la cellule et la valeur de cellule sur lesquelles vous enverrez un e-mail.
2). Veuillez modifier le corps de l'e-mail selon vos besoins dans xMailCorps ligne dans le code.
3). Remplacez l'adresse e-mail par l'adresse e-mail du destinataire dans la ligne .To = "Adresse e-mail".
4). Et spécifiez les destinataires Cc et Bcc selon vos besoins dans .CC = "" et des tours Cci = "" sections.
5). Enfin, changez le sujet de l'e-mail en ligne .Subject = "envoyer par test de valeur de cellule".

3. appuie sur le autre + Q clés ensemble pour fermer le Microsoft Visual Basic pour applications fenêtre.

À partir de maintenant, lorsque la valeur que vous entrez dans la cellule D7 est supérieure à 200, un e-mail avec des destinataires et un corps spécifiés sera créé automatiquement dans Outlook. Vous pouvez cliquer sur le Envoyer bouton pour envoyer cet e-mail. Voir la capture d'écran:

Notes:

1. Le code VBA ne fonctionne que lorsque vous utilisez Outlook comme programme de messagerie.

2. Si les données saisies dans la cellule D7 sont une valeur de texte, la fenêtre d'e-mail apparaîtra également.


Envoyez facilement des e-mails via Outlook en fonction des champs de la liste de diffusion créée dans Excel:

La série Envoyer des emails utilité de Kutools pour Excel aide les utilisateurs à envoyer des e-mails via Outlook en fonction de la liste de diffusion créée dans Excel.
Téléchargez et essayez-le maintenant! (Parcours gratuit de 30 jours)


Articles Liés:


Les meilleurs outils de productivité de bureau

Kutools for Excel résout la plupart de vos problèmes et augmente votre productivité de 80%

  • Réutilisation: Insérer rapidement formules complexes, graphiques et tout ce que vous avez utilisé auparavant; Crypter les cellules avec mot de passe; Créer une liste de diffusion et envoyer des e-mails ...
  • Barre Super Formula (modifiez facilement plusieurs lignes de texte et de formule); Disposition de lecture (lire et modifier facilement un grand nombre de cellules); Coller dans la plage filtréeplus
  • Fusionner les cellules / lignes / colonnes sans perdre de données; Contenu des cellules divisées; Combiner des lignes / colonnes en double... Empêcher les cellules en double; Comparer les gammesplus
  • Sélectionnez Dupliquer ou Unique Lignes; Sélectionnez les lignes vides (toutes les cellules sont vides); Super Find et Fuzzy Find dans de nombreux classeurs; Sélection aléatoire ...
  • Copie exacte Plusieurs cellules sans changer la référence de formule; Créer automatiquement des références à plusieurs feuilles; Insérer des puces, Cases à cocher et plus encore ...
  • Extrait du texte, Ajouter du texte, Supprimer par position, Supprimer l'espace; Créer et imprimer des sous-totaux de pagination; Conversion entre le contenu et les commentaires des cellulesplus
  • Super filtre (enregistrer et appliquer des schémas de filtrage à d'autres feuilles); Tri avancé par mois / semaine / jour, fréquence et plus; Filtre spécial par gras, italique ...
  • Combiner des classeurs et des feuilles de travail; Fusionner les tableaux en fonction des colonnes clés; Diviser les données en plusieurs feuilles; Conversion par lots xls, xlsx et PDFplus
  • Plus de 300 fonctionnalités puissantes. Prend en charge Office / Excel 2007-2019 et 365. Prend en charge toutes les langues. Déploiement facile dans votre entreprise ou organisation. Essai gratuit de 30 jours. Garantie de remboursement de 60 jours.
onglet kte 201905

Office Tab apporte une interface à onglets à Office et simplifie considérablement votre travail

  • Activer l'édition et la lecture par onglets dans Word, Excel, PowerPoint, Publisher, Access, Visio et Project.
  • Ouvrez et créez plusieurs documents dans de nouveaux onglets de la même fenêtre, plutôt que dans de nouvelles fenêtres.
  • Augmente votre productivité de 50% et réduit des centaines de clics de souris chaque jour!
bas de cabine
Commentaires (298)
Noté 5 hors 5 · évaluations 1
Ce commentaire a été minimisé par le modérateur sur le site
Comment le code doit-il être modifié pour s'appliquer à toute une plage de cellules ?
Ce commentaire a été minimisé par le modérateur sur le site
Chère Debbie,
Veuillez essayer ci-dessous le code VBA pour résoudre le problème.

Private Sub Worksheet_Change (Cible ByVal en tant que plage)
Si Target.Cells.Count > 1 Alors Quittez Sub
If (Not Intersect(Target, Range("A1:D4")) N'est rien) And (Target.Value > 200) Alors
Appelez Mail_small_Text_Outlook
Si fin
End Sub
Sous-mail_small_Text_Outlook()
Dim xOutApp en tant qu'objet
Estomper xOutMail en tant qu'objet
Estomper xMailBody en tant que chaîne
Set xOutApp = CreateObject("Outlook.Application")
Définir xOutMail = xOutApp.CreateItem(0)
xMailBody = "Bonjour" & vbNewLine & vbNewLine & _
"Ceci est la ligne 1" & vbNewLine & _
"C'est la ligne 2"
On Error Resume Next
Avec xOutMail
.To = "L'adresse e-mail de votre destinataire"
.CC = ""
.BCC = ""
.Subject = "envoyer par test de valeur de cellule"
.Body = xMailBody
.Afficher 'ou utiliser .Envoyer
Terminer par
En cas d'erreur GoTo 0
Définir xOutMail = Rien
Définir xOutApp = Rien
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
J'ai du mal à obtenir ce code pour demander si la valeur de la cellule est modifiée indirectement. Par exemple, si j'ai l'équation Sum qui change automatiquement cette valeur. Lorsque l'équation s'exécute et que la valeur dépasse la valeur définie pour inviter l'e-mail, ce n'est pas le cas, à moins que je ne modifie physiquement le nombre moi-même. Existe-t-il un moyen de rendre l'invite de courrier électronique même si elle est modifiée indirectement?
Ce commentaire a été minimisé par le modérateur sur le site
Cher Jordan,
Le code VBA suivant peut vous aider à résoudre le problème. N'oubliez pas de remplacer "l'adresse e-mail" par l'adresse e-mail du destinataire dans le code. Merci.

Private Sub Worksheet_Change (Cible ByVal en tant que plage)
Dim xRgPre As Range
On Error Resume Next
Si Target.Cells.Count > 1 Alors Quittez Sub
Définir xRg = Range ("D7")
Set xRgPre = xRg.Precedents
Si xRg.Valeur > 200 Alors
Si Target.Address = xRg.Address Alors
Appelez Mail_small_Text_Outlook
ElseIf (Not xRgPre Is Nothing) And (Intersect(Target, xRgPre).Address = Target.Address) Alors
Appelez Mail_small_Text_Outlook
Si fin
Si fin
End Sub
Sous-mail_small_Text_Outlook()
Dim xOutApp en tant qu'objet
Estomper xOutMail en tant qu'objet
Estomper xMailBody en tant que chaîne
Set xOutApp = CreateObject("Outlook.Application")
Définir xOutMail = xOutApp.CreateItem(0)
xMailBody = "Bonjour" & vbNewLine & vbNewLine & _
"Ceci est la ligne 1" & vbNewLine & _
"C'est la ligne 2"
On Error Resume Next
Avec xOutMail
.To = "Adresse e-mail"
.CC = ""
.BCC = ""
.Subject = "envoyer par test de valeur de cellule"
.Body = xMailBody
.Afficher 'ou utiliser .Envoyer
Terminer par
En cas d'erreur GoTo 0
Définir xOutMail = Rien
Définir xOutApp = Rien
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
J'ai modifié le code suggéré pour essayer de le faire fonctionner pour mon application.
Changé xRg = Range("C2:C40") et Si xRg.Value = -1.

Le problème que j'ai est chaque fois qu'il y a un changement dans n'importe quelle cellule et tant que l'une des cellules de ma plage est = -1, elle appellera Mail_small_Text_Outlook.
J'essaie d'appeler uniquement si une cellule de ma plage est modifiée indirectement en -1.
Je me demandais aussi si et comment il serait possible qu'il réponde à deux critères.
Comme vérifier la plage A et la plage B et si elles répondent aux critères, appelez la fonction.

Merci d'avance pour l'aide. Je suis nouveau dans tout cela, mais la lecture de ce fil m'a permis d'atteindre environ 90 %.


Private Sub Worksheet_Change (Cible ByVal en tant que plage)
Dim xRgPre As Range
On Error Resume Next
Si Target.Cells.Count > 1 Alors Quittez Sub
Définir xRg = Plage("C2:C40")
Set xRgPre = xRg.Precedents
Si xRg.Valeur = -1 Alors
Si Target.Address = xRg.Address Alors
Appelez Mail_small_Text_Outlook
ElseIf (Not xRgPre Is Nothing) And (Intersect(Target, xRgPre).Address = Target.Address) Alors
Appelez Mail_small_Text_Outlook
Si fin
Si fin
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
J'ai utilisé ce code avec le seul changement étant que je l'ai appliqué à une colonne entière [Set xRg = Range("D4:D13")]. Désormais, l'événement se déclenche chaque fois qu'un calcul est effectué, que la vanne de la colonne D soit ou non inférieure à la valeur cible. Une idée pourquoi c'est?


Dim Xrg As Range
Private Sub Worksheet_Change (Cible ByVal en tant que plage)
Dim xRgPre As Range
On Error Resume Next
Si Target.Cells.Count > 1 Alors Quittez Sub
Définir Xrg = Plage("D4:D13")
Set xRgPre = Xrg.Precedents
Si Xrg.Value < 1200 Alors
Si Target.Address = Xrg.Address Alors
Appelez Mail_small_Text_Outlook
ElseIf (Not xRgPre Is Nothing) And (Intersect(Target, xRgPre).Address = Target.Address) Alors
Appelez Mail_small_Text_Outlook
Si fin
Si fin
End Sub

Sous-mail_small_Text_Outlook()
Dim xOutApp en tant qu'objet
Estomper xOutMail en tant qu'objet
Estomper xMailBody en tant que chaîne
Set xOutApp = CreateObject("Outlook.Application")
Définir xOutMail = xOutApp.CreateItem(0)
xMailBody = "Salut" & vbNewLine & _
"Tester vba" _
& vbNouvelleLigne & _
"Ligne 2."
On Error Resume Next
Avec xOutMail
.À = ""
.CC = ""
.BCC = ""
.Subject = "Test de messagerie automatique"
.Body = xMailBody
.Afficher
Terminer par
En cas d'erreur GoTo 0
Définir xOutMail = Rien
Définir xOutApp = Rien

End Sub


Merci.
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour

Je rencontre des problèmes car le destinataire de l'e-mail doit être ajouté encore et encore un par un. Veuillez indiquer si la liste des destinataires des e-mails peut être ajoutée à cette fonction afin que la fonction sélectionne l'adresse e-mail dans la liste des adresses e-mail fournies ou télécharge la liste et que la fonction envoie l'e-mail, déjà composé, au destinataire souhaité.
Ce commentaire a été minimisé par le modérateur sur le site
Cher Henri,
Le code VBA suivant peut vous aider à résoudre le problème. Veuillez placer le script VBA dans votre module de feuille de calcul. Lorsque la valeur dans la cellule spécifiée remplit la condition, une boîte de dialogue Kutools for Excel apparaîtra, veuillez sélectionner les cellules qui contiennent les adresses e-mail des destinataires, puis cliquez sur le bouton OK. Ensuite, les e-mails avec des destinataires spécifiés s'ouvrent. Veuillez les envoyer selon vos besoins.

Private Sub Worksheet_Change (Cible ByVal en tant que plage)
Si Target.Cells.Count > 1 Alors Quittez Sub
Définir xRg = Range ("D7")
Si xRg = Target And Target.Value > 200 Alors
Appelez Mail_small_Text_Outlook
Si fin
End Sub
Sous-mail_small_Text_Outlook()
Dim xOutApp en tant qu'objet
Estomper xOutMail en tant qu'objet
Estomper xMailBody en tant que chaîne
Dim xRgMsg As Range
Dim xCell As Range
Set xRgMsg = Application.InputBox("Veuillez sélectionner les cellules d'adresse:", "Kutools for Excel", , , , , , 8)
xMailBody = "Bonjour" & vbNewLine & vbNewLine & _
"Ceci est la ligne 1" & vbNewLine & _
"C'est la ligne 2"
On Error Resume Next
Pour chaque xCell dans xRgMsg
Set xOutApp = CreateObject("Outlook.Application")
Définir xOutMail = xOutApp.CreateItem(0)
Avec xOutMail
.To = xCell.Valeur
.CC = ""
.BCC = ""
.Subject = "envoyer par test de valeur de cellule"
.Body = xMailBody
.Afficher 'ou utiliser .Envoyer
Terminer par
xOutApp = Rien
xOutMail = Rien
Suivant
En cas d'erreur GoTo 0
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
sera-t-il envoyé automatiquement par courrier, sans aucune interruption manuelle
Ce commentaire a été minimisé par le modérateur sur le site
Cher Brahmâ,
Si vous souhaitez envoyer directement l'e-mail sans l'afficher, veuillez remplacer la ligne ".Display" par ".Send" dans le code VBA ci-dessus.
Ce commentaire a été minimisé par le modérateur sur le site
Salut j'ai mis le même script mais il ne marche pas svp aidez moi dans la 1ère partie

Dim xRg As Range

Private Sub Worksheet_Change (Cible ByVal en tant que plage)
Si Target.Cells.Count > 1 Alors Quittez Sub
Définir xRg = Range ("D7")
Si xRg = Cible Et Cible.Valeur = 200 Alors
Appelez Mail_small_Text_Outlook
Si fin

End Sub
Ce commentaire a été minimisé par le modérateur sur le site
Cher basilic,
Y a-t-il un avertissement lors de l'exécution du code ?
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour, comment modifieriez-vous ce code pour vérifier si un groupe de cellules a la chaîne "Aucune correspondance" et envoyer un e-mail si c'est le cas.
Ce commentaire a été minimisé par le modérateur sur le site
Cher José,
Veuillez essayer ci-dessous le code VBA. Lors de l'exécution du code, une boîte de dialogue apparaît, veuillez sélectionner la plage que vous allez vérifier pour la chaîne, puis cliquez sur le bouton OK. si la chaîne n'existe pas, vous obtiendrez une boîte de dialogue d'invite. Si la chaîne existe dans la plage, un e-mail avec le destinataire, l'objet et le corps spécifiés s'affichera.

Sous EnvoyerEmail()
Dim I As Long
Dim J aussi longtemps
Dim xRg As Range
Dim xArr
Dim xOutApp en tant qu'objet
Estomper xOutMail en tant qu'objet
Estomper xMailBody en tant que chaîne
Dim xFlag As Boolean
On Error Resume Next
Set xRg = Application.InputBox("Veuillez sélectionner la plage", "Kutools for Excel", Selection.Address, , , , , 8)
Si xRg n'est rien, quittez Sub
xArr = xRg.Valeur
xFlag = Faux
Pour I = 1 Vers UBound(xArr)
Pour J = 1 Vers UBound(xArr, 2)
Si xArr(I, J) = "Pas de correspondance" Alors
xFlag = Vrai
Si fin
Suivant
Suivant
Si xFlag Alors
Set xOutApp = CreateObject("Outlook.Application")
Définir xOutMail = xOutApp.CreateItem(0)
xMailBody = "Bonjour" & vbNewLine & vbNewLine & _
"Ceci est la ligne 1" & vbNewLine & _
"C'est la ligne 2"
Avec xOutMail
.To = "Adresse e-mail"
.CC = ""
.BCC = ""
.Subject = "Correspondance"
.Body = xMailBody
.Afficher 'ou utiliser .Envoyer
Terminer par
autre
MsgBox "Aucune valeur correspondante trouvée", vbInformation, "KuTools for Excel"
Si fin
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
Comment puis-je modifier ce code pour envoyer les notes des élèves aux parents. Où si la colonne A est la note et la colonne B est l'e-mail parent. Je souhaite remplir un e-mail pour chaque élève avec un F comme note.
Ce commentaire a été minimisé par le modérateur sur le site
Cher Franck,
Le code VBA ci-dessous peut vous aider à résoudre le problème. Merci.

Sous-mail_small_Text_Outlook()
Dim xRg As Range
Dim I As Long
Dim xRows As Long
Dim xVal en tant que chaîne
Dim xOutApp en tant qu'objet
Estomper xOutMail en tant qu'objet
Estomper xMailBody en tant que chaîne
On Error Resume Next
Set xRg = Application.InputBox("Veuillez sélectionner la colonne des notes et la colonne des e-mails (deux colonnes)", "Kutools for Excel", Selection.Address, , , , , 8)
Si xRg n'est rien, quittez Sub
xRows = xRg.Rows.Count
Fixer xRg = xRg(2)
Pour I = 1 Vers xLignes
xVal = xRg.Décalage(I, -1).Texte
Si xVal = "F" Alors
Set xOutApp = CreateObject("Outlook.Application")
Définir xOutMail = xOutApp.CreateItem(0)
xMailBody = "Bonjour" & vbNewLine & vbNewLine & _
"C'est la classe de votre enfant" & xRg.Offset(I, -1).Text
Avec xOutMail
.to = xRg.Offset(I, 0).Texte
.Subject = "envoyer par test de valeur de cellule"
.Body = xMailBody
.Afficher 'ou utiliser .Envoyer
Terminer par
En cas d'erreur GoTo 0
Définir xOutMail = Rien
Définir xOutApp = Rien
Si fin
Suivant
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
J'ai une liste d'adresses email déjà dans un fichier excel, comment puis-je modifier le code pour choisir automatiquement l'adresse email de la personne si sa cellule D7 est >200 ?
Ce commentaire a été minimisé par le modérateur sur le site
Good Day,
Le code VBA suivant peut vous aider à résoudre le problème. Veuillez placer le script VBA dans votre module de feuille de calcul. Lorsque la valeur dans la cellule spécifiée remplit la condition, une boîte de dialogue Kutools for Excel apparaîtra, veuillez sélectionner les cellules qui contiennent les adresses e-mail des destinataires, puis cliquez sur le bouton OK. Ensuite, les e-mails avec des destinataires spécifiés s'ouvrent. Veuillez les envoyer selon vos besoins.

Private Sub Worksheet_Change (Cible ByVal en tant que plage)
Si Target.Cells.Count > 1 Alors Quittez Sub
Définir xRg = Range ("D7")
Si xRg = Target And Target.Value > 200 Alors
Appelez Mail_small_Text_Outlook
Si fin
End Sub
Sous-mail_small_Text_Outlook()
Dim xOutApp en tant qu'objet
Estomper xOutMail en tant qu'objet
Estomper xMailBody en tant que chaîne
Dim xRgMsg As Range
Dim xCell As Range
Set xRgMsg = Application.InputBox("Veuillez sélectionner les cellules d'adresse:", "Kutools for Excel", , , , , , 8)
xMailBody = "Bonjour" & vbNewLine & vbNewLine & _
"Ceci est la ligne 1" & vbNewLine & _
"C'est la ligne 2"
On Error Resume Next
Pour chaque xCell dans xRgMsg
Set xOutApp = CreateObject("Outlook.Application")
Définir xOutMail = xOutApp.CreateItem(0)
Avec xOutMail
.To = xCell.Valeur
.CC = ""
.BCC = ""
.Subject = "envoyer par test de valeur de cellule"
.Body = xMailBody
.Afficher 'ou utiliser .Envoyer
Terminer par
xOutApp = Rien
xOutMail = Rien
Suivant
En cas d'erreur GoTo 0
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
J'ai des difficultés à envoyer des mails via Outlook. Je reçois l'erreur disant "Un programme essaie d'envoyer un e-mail en votre nom. Si cela est inattendu, veuillez refuser et vérifier que votre logiciel antivirus est à jour"
Merci de m'aider car je n'arrive pas à l'automatiser.
Ce commentaire a été minimisé par le modérateur sur le site
Désolé mayank,
Le code fonctionne bien dans mon cas. Il semble que quelque chose à propos de la fonction "envoyer au nom" soit configuré dans votre Outlook. Veuillez vérifier.
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour, quel code utiliserais-je si j'essaie d'envoyer un e-mail à un gestionnaire qui a une liste des fruits qui ont une quantité> 200 une fois par mois (basé sur votre exemple) ou expire bientôt (basé sur les dates)
Ce commentaire a été minimisé par le modérateur sur le site
Bonne journée
Peut-être la méthode dans cet article "Comment envoyer un e-mail si la date d'échéance a été respectée dans Excel ?" peut vous aider.
Veuillez suivre ce lien: https://www.extendoffice.com/documents/excel/4664-excel-send-email-if-due-date-has-been-met.html
Ce commentaire a été minimisé par le modérateur sur le site
Comment puis-je modifier le code pour envoyer un e-mail en fonction d'une date dans la cellule. Par exemple, j'ai besoin d'un document révisé tous les 15 mois et je veux envoyer un e-mail à 12 mois à une adresse e-mail indiquant que le document doit être révisé. Je l'ai maintenant pour envoyer automatiquement un e-mail en changeant .Display en .Send et cela fonctionne très bien comme écrit, mais que dois-je changer pour utiliser une fonction de date au lieu d'un nombre entier ??
Ce commentaire a été minimisé par le modérateur sur le site
Comment pouvez-vous ajouter une plage multiple à "Set xRg = Range("D7")". Je veux le modifier et ajouter Range("D7:F7"). Cependant, je reçois une erreur d'erreur d'exécution 13, incompatibilité de type et cela me conduit à If xRg = Target And Target.Value> 2 Then.


Comment puis-je résoudre ce problème?
Ce commentaire a été minimisé par le modérateur sur le site
Good Day,
Veuillez essayer ci-dessous le code VBA pour résoudre le problème.

Private Sub Worksheet_Change (Cible ByVal en tant que plage)
Si Target.Cells.Count > 1 Alors Quittez Sub
If (Not Intersect(Target, Range("D7:F7")) Is Nothing) And (Target.Value > 200) Alors
Appelez Mail_small_Text_Outlook
Si fin
End Sub
Sous-mail_small_Text_Outlook()
Dim xOutApp en tant qu'objet
Estomper xOutMail en tant qu'objet
Estomper xMailBody en tant que chaîne
Set xOutApp = CreateObject("Outlook.Application")
Définir xOutMail = xOutApp.CreateItem(0)
xMailBody = "Bonjour" & vbNewLine & vbNewLine & _
"Ceci est la ligne 1" & vbNewLine & _
"C'est la ligne 2"
On Error Resume Next
Avec xOutMail
.To = "L'adresse e-mail de votre destinataire"
.CC = ""
.BCC = ""
.Subject = "envoyer par test de valeur de cellule"
.Body = xMailBody
.Afficher 'ou utiliser .Envoyer
Terminer par
En cas d'erreur GoTo 0
Définir xOutMail = Rien
Définir xOutApp = Rien
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
a parfaitement fonctionné .. Merci .. :) :)
Ce commentaire a été minimisé par le modérateur sur le site
Cela ne fonctionne pas pour moi car la valeur dans D7 est le résultat d'une formule. Que se passe-t-il si la cellule D7 contient une formule, par exemple D7 =2*120 ? Il remplit toujours la condition mais rien ne se passe. S'il vous plaît aider
Ce commentaire a été minimisé par le modérateur sur le site
comment arrêter l'exécution du code, c'est-à-dire ne pas demander l'e-mail lorsque la condition n'est pas remplie ?

même lorsque D7 < 200, je reçois toujours l'e-mail.
Ce commentaire a été minimisé par le modérateur sur le site
Good Day,
Le code est mis à jour dans le message avec le problème résolu. Merci pour votre commentaire.
Ce commentaire a été minimisé par le modérateur sur le site
Hi

Merci beaucoup d'avoir publié ce code VBA et les instructions. Quand je l'ai trouvé, j'ai eu l'impression d'avoir gagné au loto. Cependant, je suis bloqué sur quelque chose, alors j'espère que vous pourrez m'aider (je suis nouveau sur VBA, je n'ai qu'une compréhension très basique).

J'ai copié le code et modifié la cellule et la valeur de la cellule pour choisir dans une plage si un critère est rempli. J'ai essayé et testé et cela fonctionne et j'ai reçu un e-mail à Outlook basé sur les critères.

1) Cependant, je n'arrive pas à comprendre comment exécuter automatiquement le code VBA lorsque j'ouvre la feuille de calcul Excel, plutôt que d'avoir à cliquer sur l'application VBA et à sélectionner Exécuter. Pourriez-vous indiquer s'il existe une invite supplémentaire à saisir dans le code VBA ci-dessus qui le fera ou doit-il être fait séparément.

2) Existe-t-il également un moyen d'obtenir le code VBA pour envoyer un courrier à une personne si la date d'échéance est oui pour un certain article, comme indiqué dans l'exemple ci-dessous.
colonne masquée par e-mail
Nom

Procédure
Procédure n°1 échéance oui
Procédure n° 2 date d'échéance non

J'aurais de nombreuses personnes dans la feuille de calcul (traversant horizontalement dans une rangée) et 'Oui' pourrait être mis en surbrillance pour diverses procédures en retard (répertoriées verticalement dans la colonne A. Existe-t-il un moyen de créer un code VBA qui s'exécute pour quelque chose comme ça - si 'Oui' pour 'Personne 1', alors envoyez un e-mail à 'personne 1' avec 'numéro de procédure' (ou numéros) et date(s) d'échéance.

Cela ne me dérangerait pas si je devais définir un code VBA distinct pour chaque personne tant qu'il envoyait un courrier de tous les documents en retard pour cette personne et les dates d'échéance.

En espérant que vous pouvez aider
Ce commentaire a été minimisé par le modérateur sur le site
Chère Ann,
Veuillez essayer le code VBA ci-dessous. Merci pour votre commentaire.

Sous-mail_small_Text_Outlook()
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim xRows As Long
Dim xCols As Long
Dim xVal en tant que chaîne
Dim xOutApp en tant qu'objet
Estomper xOutMail en tant qu'objet
Estomper xMailBody en tant que chaîne
On Error Resume Next
Set xRg = Application.InputBox("Sélectionnez la plage contient la valeur de cellule sur laquelle vous enverrez des e-mails :", "Kutools for Excel", Selection.Address, , , , , 8)
Si xRg n'est rien, quittez Sub
xRows = xRg.Rows.Count
xCols = xRg.Colonnes.Compte
Pour I = 1 Vers xLignes
Définir xCell = xRg(I, xCols)
Si xCell.Value = "Oui" Alors
Set xOutApp = CreateObject("Outlook.Application")
Définir xOutMail = xOutApp.CreateItem(0)
xMailBody = "Bonjour" & vbNewLine & vbNewLine & _
"Voici vos informations : " & vbNewLine & xCell.Offset(0, -1).Text & vbNewLine & xCell.Offset(0, -2).Text
Avec xOutMail
.To = xCellule.Décalage(0, -4).Texte
.Subject = "envoyer par test de valeur de cellule"
.Body = xMailBody
.Afficher 'ou utiliser .Envoyer
Terminer par
En cas d'erreur GoTo 0
Définir xOutMail = Rien
Définir xOutApp = Rien
Si fin
Suivant
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
Cristal,

Cela remplace le code suivant :

Sous-e-mail()

Dim xRg As Range

Dim xRgChacun comme plage

Dim xEmail_Subject, xEmail_Send_Form, etc.
Ce commentaire a été minimisé par le modérateur sur le site
Où insérons-nous exactement ce code ?
Ce commentaire a été minimisé par le modérateur sur le site
Bonne journée,
Vous devez placer le code dans la fenêtre de code de la feuille de calcul.
Ouvrez la fenêtre Microsoft Visual Basic pour Applications, double-cliquez sur le nom de la feuille dans le volet de gauche pour ouvrir l'éditeur de code.
Ce commentaire a été minimisé par le modérateur sur le site
Salut,


J'ai actuellement un peu de mal avec le codage (nouveau dans ce domaine - j'ai peut-être mordu plus que je ne peux mâcher)


J'ai actuellement une feuille de calcul avec les éléments suivants que j'ai besoin d'aide pour automatiser et envoyer des e-mails en cas de faute qui se trouvent dans nos propriétés pour notre entreprise


J'ai actuellement besoin d'un code qui utilisera les données suivantes :


1) Une adresse et le problème ( 2 cellules "générales" qui ont été fusionnées via ((Dans la cellule D1)) " = =CONCAT(B1," "C1,) "
L'adresse en B1 sera toujours la même (plus ou moins)
Tandis que C1 changera toujours en fonction du défaut de la propriété.


2) Un e-mail à envoyer par la même adresse e-mail (puis-je utiliser $E$1 ou dois-je utiliser E1 - E1. par exemple) ou puis-je simplement saisir " TheEmailAdress@.co.uk" dans la ligne de code


3) Le corps de l'e-mail doit être rempli de la même manière qu'au point 1) ...... ((Dans la cellule F1)) " =CONCAT(G1," ",H1)
Ceux-ci changeront constamment car ils représentent l'entreprise (G1) et ce qu'ils font, réparent, citent ect (H1)

4) Le déclencheur pour envoyer l'e-mail, je serais le numéro 7, la feuille est mise à jour quotidiennement (7 jours sur XNUMX)
en tant que tel, j'ai besoin du déclencheur pour envoyer l'e-mail le jour 7, mais pas constamment comme les jours 8, 9, 10+ ect. et pas avant comme 1-6, ce serait en A4 : A 100+ (car nous augmentons constamment


4) J'ai utilisé de petits extraits d'autres utilisateurs qui ont mentionné l'utilisation d'une liste pour le déclencheur pour envoyer l'e-mail, mais je n'étais pas sûr à 100% que c'était correct, mais j'en aurais besoin pour analyser tous les Collum A ... .A4 : A100
et s'il y a 47 cellules qui ne contiennent que " 7 " alors 47 e-mails seront envoyés


Merci beaucoup d'avoir lu et j'espère que vous pourrez m'aider :)
Ce commentaire a été minimisé par le modérateur sur le site
Cher Martyn,
Désolé, je ne peux pas vous aider.
Vous pouvez poser votre question sur notre forum : https://www.extendoffice.com/forum.html pour obtenir plus de supports Excel de notre personnel technique.
Merci pour votre commentaire.

Meilleures salutations,
Cristal
Ce commentaire a été minimisé par le modérateur sur le site
Hi,


Et si je voulais envoyer l'e-mail en fonction du mot "terminé" ajouté à la colonne L ?
Ce commentaire a été minimisé par le modérateur sur le site
Cher Jesse,
Le code VBA suivant peut vous aider à résoudre le problème. Merci pour votre commentaire.

Private Sub Worksheet_Change (Cible ByVal en tant que plage)
Si Target.Cells.Count > 1 Alors Quittez Sub
If (Not Intersect(Target, Range("L:L")) Is Nothing) And (Target.Value = "completed") Alors
Appelez Mail_small_Text_Outlook
Si fin
End Sub
Sous-mail_small_Text_Outlook()
Dim xOutApp en tant qu'objet
Estomper xOutMail en tant qu'objet
Estomper xMailBody en tant que chaîne
Set xOutApp = CreateObject("Outlook.Application")
Définir xOutMail = xOutApp.CreateItem(0)
xMailBody = "Bonjour" & vbNewLine & vbNewLine & _
"Ceci est la ligne 1" & vbNewLine & _
"C'est la ligne 2"
On Error Resume Next
Avec xOutMail
.To = "L'adresse e-mail de votre destinataire"
.CC = ""
.BCC = ""
.Subject = "envoyer par test de valeur de cellule"
.Body = xMailBody
.Afficher 'ou utiliser .Envoyer
Terminer par
En cas d'erreur GoTo 0
Définir xOutMail = Rien
Définir xOutApp = Rien
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
Hi,
Je voudrais qu'Outlook n'apparaisse que lorsque les données que j'ai collées dans la plage ("D7: F7") ont au moins 1 zéro ou un blanc.
J'ai supprimé la ligne "If Target.Cells.Count > 1 Then Exit Sub" et maintenant Outlook se lance toujours lorsque je colle un groupe de valeurs dans les cellules D7: F7.

Aide.
Ce commentaire a été minimisé par le modérateur sur le site
Cher Jan,
Le script suivant peut vous aider à résoudre le problème. Merci pour votre commentaire.

Private Sub Worksheet_Change (Cible ByVal en tant que plage)
Dim xOutApp en tant qu'objet
Estomper xOutMail en tant qu'objet
Estomper xMailBody en tant que chaîne
On Error Resume Next
Si Cible.Adresse = Plage("D7:F7").Adresse Alors
Avec Application.WorksheetFunction
Si .CountIf(Target, "") > 0 Ou .CountIf(Target, 0) > 0 Alors
Set xOutApp = CreateObject("Outlook.Application")
Définir xOutMail = xOutApp.CreateItem(0)
Avec xOutMail
.To = "Adresse e-mail"
.CC = ""
.BCC = ""
.Subject = "envoyer par test de valeur de cellule"
.Body = "Bonjour "
.Afficher 'ou utiliser .Envoyer
Terminer par
En cas d'erreur GoTo 0
Définir xOutMail = Rien
Définir xOutApp = Rien
Si fin
Terminer par
Si fin
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
J'ai donc utilisé votre modification pour inclure une plage de cellules mais (si nous utilisons l'exemple de feuille de calcul), je me demandais comment ajouter le type de fruit, la date et la quantité dans l'e-mail HTML de la feuille de calcul s'ils correspondent aux critères pour avoir un e-mail généré. Alors ça dirait

"Bonjour à tous,"

Nom du fruit de la cellule "Doit être mis en rupture de stock car à la date de la commande : " date de la commande de la cellule "nous avons ce montant :" quantité de la cellule.
Ce commentaire a été minimisé par le modérateur sur le site
Salut Noémie,
Veuillez essayer ce script VBA.

Private Sub Worksheet_Change (Cible ByVal en tant que plage)
Dim xRg As Range
Dim I, J, K As Long
Dim xOutApp en tant qu'objet
Estomper xOutMail en tant qu'objet
Estomper xMailBody en tant que chaîne
On Error Resume Next
Si Cible.Adresse = Plage("D7").Adresse Alors
Avec Application.WorksheetFunction
Si IsNumeric(Target.Value) et Target.Value > 200 Alors
Set xRg = Application.InputBox("Veuillez sélectionner la plage de cellules que vous afficherez dans le corps du message:", "KuTools for Excel", Selection.Address, , , , , 8)
Si xRg n'est rien, quittez Sub
Pour I = 1 To xRg.Rows.Count
Pour J = 1 À xRg.Rows(I).Columns.Count
Pour K = 1 à xRg.Rows(I).Columns(J).Count
xMailBody = xMailBody & " " & xRg.Rows(I).Columns(J).Cells(K).Text
Suivant
Suivant
xMailBody = xMailBody & vbNewLine
Suivant
Set xOutApp = CreateObject("Outlook.Application")
Définir xOutMail = xOutApp.CreateItem(0)
Avec xOutMail
.To = "Adresse e-mail"
.CC = ""
.BCC = ""
.Subject = "envoyer par test de valeur de cellule"
.Body = "Bonjour " & vbNewLine & xMailBody
.Afficher 'ou utiliser .Envoyer
Terminer par
En cas d'erreur GoTo 0
Définir xOutMail = Rien
Définir xOutApp = Rien
Si fin
Terminer par
Si fin
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
salut cristal
merci pour vos codes, si possible veuillez envoyer les codes pour les détails ci-dessous

si nous avons 8 à 9 colonnes utilisant différents types d'expiration comme la date d'expiration du passeport, la date d'expiration du permis de conduire, la date d'expiration de l'immatriculation du véhicule, la date d'expiration du laissez-passer, etc., et l'alerte par courrier doit être envoyée à seulement 5 personnes données.

comme notre feuille de date est avec plus de 300 employés, expiré et date d'expiration avec dans 15 jours en couleur rouge et une alerte par e-mail doit être envoyée.

Veuillez faire le nécessaire

Merci d'avance
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour,
Nous avons publié un article "Comment envoyer un e-mail si la date d'échéance a été respectée dans Excel ?"
Vous pouvez voir s'il y a des réponses dans cet article. Veuillez suivre ce lien pour ouvrir l'article : https://www.extendoffice.com/documents/excel/4664-excel-send-email-if-due-date-has-been-met.html
Thank you.
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour- Si je voulais envoyer un e-mail à partir d'une liste au lieu de mettre un e-mail réel dans le code, est-ce possible ? Merci
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour,
Veuillez essayer ci-dessous le code VBA, lorsque la cellule spécifiée remplit la condition, une boîte de dialogue apparaîtra, veuillez sélectionner la cellule contenant l'adresse e-mail à laquelle vous enverrez un e-mail. J'espère que cela peut aider. Merci.

Private Sub Worksheet_Change (Cible ByVal en tant que plage)
Si Target.Cells.Count > 1 Alors Quittez Sub
Définir xRg = Range ("D7")
Si xRg = Target And Target.Value > 200 Alors
Appelez Mail_small_Text_Outlook
Si fin
End Sub
Sous-mail_small_Text_Outlook()
Dim xOutApp en tant qu'objet
Estomper xOutMail en tant qu'objet
Estomper xMailBody en tant que chaîne
Dim xRgMsg As Range
Dim xCell As Range
Set xRgMsg = Application.InputBox("Veuillez sélectionner les cellules d'adresse:", "Kutools for Excel", , , , , , 8)
xMailBody = "Bonjour" & vbNewLine & vbNewLine & _
"Ceci est la ligne 1" & vbNewLine & _
"C'est la ligne 2"
On Error Resume Next
Pour chaque xCell dans xRgMsg
Set xOutApp = CreateObject("Outlook.Application")
Définir xOutMail = xOutApp.CreateItem(0)
Avec xOutMail
.To = xCell.Valeur
.CC = ""
.BCC = ""
.Subject = "envoyer par test de valeur de cellule"
.Body = xMailBody
.Afficher 'ou utiliser .Envoyer
Terminer par
xOutApp = Rien
xOutMail = Rien
Suivant
En cas d'erreur GoTo 0
End Sub
Il n'y a pas encore de commentaires postés ici
TÉLÉCHARGER PLUS
Laisser vos commentaires
Publier en tant qu'invité
×
Évaluez cet article:
0   Personnages
Emplacements suggérés