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

Comment envoyer un graphique spécifique dans un e-mail avec vba dans Excel?

Vous savez peut-être comment envoyer un e-mail via Outlook dans Excel avec le code VBA. Cependant, savez-vous comment joindre un graphique spécifique dans une certaine feuille de calcul dans le corps de l'e-mail? Cet article vous montrera la méthode pour résoudre ce problème.

Envoyer un graphique spécifique dans un e-mail dans Excel avec le code VBA


Envoyer un graphique spécifique dans un e-mail dans Excel avec le code VBA

Veuillez procéder comme suit pour envoyer un graphique spécifique dans un e-mail avec le code VBA dans Excel.

1. Dans la feuille de calcul contient le graphique que vous souhaitez joindre au corps de l'e-mail, appuyez sur le bouton autre + F11 clés pour ouvrir le Microsoft Visual Basic pour applications fenêtre.

2. dans le Microsoft Visual Basic pour applications fenêtre, veuillez cliquer insérer > Module. Copiez ensuite le code VBA ci-dessous dans la fenêtre Code.

Code VBA: envoyer un graphique spécifique dans un e-mail dans Excel

Sub mailHTMLsend()
'Updated by Extendoffice 2018/3/5
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xStartMsg As String
    Dim xEndMsg As String
    Dim xChartName As String
    Dim xChartPath As String
    Dim xPath As String
    Dim xChart As ChartObject
    On Error Resume Next
    xChartName = Application.InputBox("Please enter the chart name:", "KuTools for Excel", , , , , , 2)
    If xChartName = "" Then Exit Sub
    Set xChart = Sheets("Sheet1").ChartObjects(xChartName) 'Change "Sheet1" to your worksheet name
    If xChart Is Nothing Then Exit Sub
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xStartMsg = "<font size='5' color='black'> Good Day," & "<br> <br>" & "Please find the chart below: " & "<br> <br> </font>"
    xEndMsg = "<font size='4' color='black'> Many Thanks," & "<br> <br> </font>"
    xChartPath = Application.ActiveWorkbook.Path & "\" & Environ("USERNAME") & VBA.Format(VBA.Now(), "DD_MM_YY_HH_MM_SS") & ".bmp"
    xPath = "<p align='Left'><img src=" & "cid:" & Mid(xChartPath, InStrRev(xChartPath, "\") + 1) & """  width=700 height=500 > <br> <br>"
    xChart.Chart.Export xChartPath
    With xOutMail
        .To = "xrr@163.com"
        .Subject = "Add Chart in outlook mail body"
        .Attachments.Add xChartPath
        .HTMLBody = xStartMsg & xPath & xEndMsg
        .Display
    End With
    Kill xChartPath
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

Notes: Dans le code, veuillez modifier l'adresse e-mail du destinataire et l'objet de l'e-mail en ligne .To = "xrr@163.com" et la ligne .Subject = "Ajouter un graphique dans le corps du courrier Outlook" , Sheet1 est la feuille qui contient le graphique que vous souhaitez envoyer, veuillez la changer pour la vôtre.

3. appuie sur le F5 clé pour exécuter le code. Dans l'ouverture Kutools pour Excel boîte de dialogue, entrez le nom du graphique que vous joindrez dans le corps de l'e-mail, puis cliquez sur le bouton OK bouton. Voir la capture d'écran:

Ensuite, un e-mail est créé automatiquement avec le graphique spécifié affiché dans le corps de l'e-mail comme illustré ci-dessous. Veuillez cliquer sur le bouton Envoyer pour envoyer cet e-mail.


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-2021 et 365. Prend en charge toutes les langues. Déploiement facile dans votre entreprise ou organisation. Fonctionnalités complètes 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 (12)
Pas encore de notes. Soyez le premier à évaluer!
Ce commentaire a été minimisé par le modérateur sur le site
lorsque j'entre le nom du graphique, le courrier ne génère pas, la boîte de dialogue se ferme, avez-vous une idée de ce que j'ai fait de mal? J'ai suivi chaque étape
Ce commentaire a été minimisé par le modérateur sur le site
Le problème est que nous ne pouvons pas définir de noms pour les objets graphiques tels que les tables. Vous devez transmettre l'ID entier pour que cela fonctionne. Par exemple, si vous n'avez qu'un seul graphique dans "Sheet1", essayez de transmettre la valeur 1 lorsque la msgbox apparaît.

PS : désolé pour le mauvais anglais :]
Ce commentaire a été minimisé par le modérateur sur le site
hola como puede enviar por correo, una tabla dinámica, y no un gráfico
Ce commentaire a été minimisé par le modérateur sur le site
Il y a une erreur dans le code : "\") + 1) & "" " width=700 height=50Dans le texte en gras, celui du milieu doit être une virgule inversée

Ce commentaire a été minimisé par le modérateur sur le site
Il inclut le tableau en pièce jointe. Avez-vous une idée de comment l'inclure en tant qu'image dans le corps du courrier lui-même. Merci Yousef
Ce commentaire a été minimisé par le modérateur sur le site
Même problème, une solution ?
Ce commentaire a été minimisé par le modérateur sur le site
Salut J,
Le code a été mis à jour. Veuillez essayer. Désolé pour le dérangement.


Sub mailHTMLsend()
'Updated by Extendoffice 2018/3/5
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xStartMsg As String
    Dim xEndMsg As String
    Dim xChartName As String
    Dim xChartPath As String
    Dim xPath As String
    Dim xChart As ChartObject
    On Error Resume Next
    xChartName = Application.InputBox("Please enter the chart name:", "KuTools for Excel", , , , , , 2)
    If xChartName = "" Then Exit Sub
    Set xChart = Sheets("Sheet1").ChartObjects(xChartName) 'Change "Sheet1" to your worksheet name
    If xChart Is Nothing Then Exit Sub
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xStartMsg = "<font size='5' color='black'> Good Day," & "<br> <br>" & "Please find the chart below: " & "<br> <br> </font>"
    xEndMsg = "<font size='4' color='black'> Many Thanks," & "<br> <br> </font>"
    xChartPath = Application.ActiveWorkbook.Path & "\" & Environ("USERNAME") & VBA.Format(VBA.Now(), "DD_MM_YY_HH_MM_SS") & ".bmp"
    xPath = "<p align='Left'><img src="/%20&%20"cid:" & Mid(xChartPath, InStrRev(xChartPath, "\") + 1) & """  width=700 height=500 > <br> <br>"
    xChart.Chart.Export xChartPath
    With xOutMail
        .To = "xrr@163.com"
        .Subject = "Add Chart in outlook mail body"
        .Attachments.Add xChartPath
        .HTMLBody = xStartMsg & xPath & xEndMsg
        .Display
    End With
    Kill xChartPath
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour,
mi nic sie nie załącza, czy coś tutaj należałoby wpisać jeszcze ?
xPath = "co tutaj trzeba wprowadzić?"
Ce commentaire a été minimisé par le modérateur sur le site
Salut Kuba,
Veuillez supprimer le / faire <img src="/.
L'erreur est causée par l'éditeur du site.
Désolé pour le désagrément.
Ce commentaire a été minimisé par le modérateur sur le site
cześć, pełny kod działa tylko do momentu podglądu komunikatu, przy wysyłce adresat otrzymuje błąd i wykresu nie widać ("Nie można wyświetlić połączonego obrazu. Plik mógł zostać przeniesiony lub usunięty albo zmieniono jego nazwę. Sprawdź czy łącze wskazuje poprawny plik i lokazlizację.") Czy z Was też tak ktoś miał czy tylko u mnie taki zonk ? Prosze o pomoc, tutaj kod, który dotyczy wykresum już tak mało brakuje :)

Dim xChartName As String
Dim xChartPath As String
Estomper xPath en tant que chaîne
Dim xChart As ChartObject
On Error Resume Next
Dim wydzialy As String
wydzialy = lista.Cells(3, 75)
xChartName = Application.InputBox(wydzialy, "KuTools for Excel", , , , , , 2) 'Wykres1 '"Veuillez entrer le nom du graphique :"
Si xChartName = "" alors quitter le sous-marin
Set xChart = Sheets("Wykresy").ChartObjects(xChartName) 'Remplacez "Sheet1" par le nom de votre feuille de calcul
Si xChart n'est rien, quittez Sub
xChartPath = Application.ActiveWorkbook.Path & "\" & Environ("USERNAME") & VBA.Format(VBA.Now(), "DD_MM_YY_HH_MM_SS") & ".svg" '.bmp '.svg '.svg ma lepsza jakość
xChemin = " "
xChart.Chart.Export xChartPath


Dim OutApp en tant qu'objet
Dim OutMail en tant qu'objet
Set OutApp = CreateObject("Outlook.Application")
Définir OutMail = OutApp.CreateItem(0)
Avec OutMail
.À = e-mails(b)
.CC = emails_dw(b)
.Subject = "XXXX" ' - " & lista.Cells(i, 66)
.Attachments.Add xChartPath
.HTMLBody = "treść" & xPath

Définir .SendUsingAccount = OutApp.Session.Accounts.Item(1)

.Afficher
Terminer par
Tuer xChartPath
Définir OutMail = Rien
Définir OutApp = Rien
Ce commentaire a été minimisé par le modérateur sur le site
Salut Kuba,
Le code a été mis à jour. Le destinataire peut voir le graphique normalement. Veuillez essayer.
Notes: Dans le code, veuillez changer le "Graphique 1" à votre propre nom de graphique. Et spécifiez l'adresse e-mail dans le champ À.
Sub mailHTMLsend()
'Updated by Extendoffice 20221013
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xStartMsg As String
    Dim xEndMsg As String
    Dim xChartName 'As String
    Dim xChartPath As String
    Dim xPath As String
    Dim xChart As ChartObject
    On Error Resume Next
    xChartName = "Chart 1" 'The name of the chart in the current worksheet you want to send.
    If xChartName = "" Then Exit Sub
    Set xChart = Application.ActiveSheet.ChartObjects(xChartName)
    If xChart Is Nothing Then Exit Sub
    
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    
    xStartMsg = "<font size='5' color='black'> Good Day," & "<br> <br>" & "Please find the chart below: " & "<br> <br> </font>"
    xEndMsg = "<font size='4' color='black'> Many Thanks," & "<br> <br> </font>"
    xChartPath = Application.ActiveWorkbook.Path & "\" & Environ("USERNAME") & VBA.Format(VBA.Now(), "DD_MM_YY_HH_MM_SS") & ".bmp"
    
    xPath = "<p align='Left'><img src="/%20&%20"cid:" & Mid(xChartPath, InStrRev(xChartPath, "\") + 1) & """  width=700 height=500 > <br> <br>"
    
    xChart.Chart.Export xChartPath
    With xOutMail
        .To = "Email Address"
        .Subject = "Add Chart in outlook mail body"
        .Attachments.Add xChartPath
        .HTMLBody = xStartMsg & xPath & xEndMsg
        .Display
    End With
    Kill xChartPath
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
BONJOUR, je souhaite ajouter de l'espace dans le corps du message, quel mot-clé dois-je utiliser.
Il n'y a pas encore de commentaires postés ici
Laisser vos commentaires
Publier en tant qu'invité
×
Évaluez cet article:
0   Personnages
Emplacements suggérés

Nous suivre

Copyright © 2009 - www.extendoffice.com. | Tous les droits sont réservés. Alimenté par ExtendOffice. | | Plan du site
Microsoft et le logo Office sont des marques commerciales ou des marques déposées de Microsoft Corporation aux États-Unis et / ou dans d'autres pays.
Protégé par Sectigo SSL