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

Wie sende ich ein bestimmtes Diagramm in einer E-Mail mit vba in Excel?

Möglicherweise wissen Sie, wie Sie eine E-Mail über Outlook in Excel mit VBA-Code senden. Wissen Sie jedoch, wie Sie ein bestimmtes Diagramm in einem bestimmten Arbeitsblatt an den Text der E-Mail anhängen können? Dieser Artikel zeigt Ihnen die Methode zur Lösung dieses Problems.

Senden Sie ein bestimmtes Diagramm in einer E-Mail in Excel mit VBA-Code


Senden Sie ein bestimmtes Diagramm in einer E-Mail in Excel mit VBA-Code

Gehen Sie wie folgt vor, um ein bestimmtes Diagramm in einer E-Mail mit VBA-Code in Excel zu senden.

1. Drücken Sie im Arbeitsblatt, das das Diagramm enthält, das Sie in den E-Mail-Text einfügen möchten, die Taste Andere + F11 Schlüssel zum Öffnen der Microsoft Visual Basic für Applikationen Fenster.

2. In dem Microsoft Visual Basic für Applikationen Fenster, bitte klicken Insert > Modul. Kopieren Sie dann den folgenden VBA-Code in das Code-Fenster.

VBA-Code: Senden Sie ein bestimmtes Diagramm in einer E-Mail in 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

Hinweis: Ändern Sie im Code die E-Mail-Adresse des Empfängers und den Betreff der E-Mail .To = "xrr@163.com" und Linie .Subject = "Diagramm im Outlook-E-Mail-Text hinzufügen" , Sheet1 Ist das Blatt, das das Diagramm enthält, das Sie senden möchten, ändern Sie es bitte in Ihr eigenes.

3. Drücken Sie die Taste F5 Schlüssel zum Ausführen des Codes. In der Eröffnung Kutools for Excel Geben Sie im Dialogfeld den Namen des Diagramms ein, das Sie in den E-Mail-Text einfügen möchten, und klicken Sie dann auf OK Taste. Siehe Screenshot:

Anschließend wird automatisch eine E-Mail mit dem angegebenen Diagramm erstellt, das im E-Mail-Text angezeigt wird (siehe Abbildung unten). Bitte klicken Sie auf die Schaltfläche Senden, um diese E-Mail zu senden.


In Verbindung stehende Artikel:

 

 

 


Die besten Tools für die Office-Produktivität

Kutools for Excel löst die meisten Ihrer Probleme und erhöht Ihre Produktivität um 80%

  • Wiederverwendung: Schnell einfügen komplexe Formeln, Diagramme und alles, was du vorher benutzt hast; Zellen verschlüsseln mit Passwort; Mailingliste erstellen und E-Mails senden ...
  • Super Formelriegel (leicht mehrere Textzeilen und Formeln bearbeiten); Layout lesen (leichtes Lesen und Bearbeiten einer großen Anzahl von Zellen); In gefilterten Bereich einfügen...
  • Zellen / Zeilen / Spalten zusammenführen ohne Daten zu verlieren; Inhalt geteilter Zellen; Kombinieren Sie doppelte Zeilen / Spalten... doppelte Zellen verhindern; Bereiche vergleichen...
  • Wählen Sie Duplizieren oder Eindeutig Reihen; Wählen Sie Leere Zeilen (alle Zellen sind leer); Super Find und Fuzzy Find in vielen Arbeitsmappen; Zufällige Auswahl ...
  • Exakte Kopie Mehrere Zellen ohne Änderung der Formelreferenz; Referenzen automatisch erstellen zu mehreren Blättern; Aufzählungszeichen einfügen, Kontrollkästchen und mehr ...
  • Text extrahieren, Text hinzufügen, Nach Position entfernen, Leerzeichen entfernen;; Paging-Zwischensummen erstellen und drucken; Inhalt und Kommentare zwischen Zellen konvertieren...
  • Superfilter (Speichern und Anwenden von Filterschemata auf andere Blätter); Erweiterte Sortierung nach Monat / Woche / Tag, Häufigkeit und mehr; Spezialfilter fett, kursiv ...
  • Kombinieren Sie Arbeitsmappen und Arbeitsblätter;; Tabellen basierend auf Schlüsselspalten zusammenführen; Daten in mehrere Blätter aufteilen; Batch-Konvertierung von xls, xlsx und PDF...
  • Mehr als 300 leistungsstarke Funktionen. Unterstützt Office / Excel 2007-2021 und 365. Unterstützt alle Sprachen. Einfache Bereitstellung in Ihrem Unternehmen oder Ihrer Organisation. 30-tägige kostenlose Testversion mit allen Funktionen. 60 Tage Geld-zurück-Garantie.
kte tab 201905

Office Tab Bringt die Oberfläche mit Registerkarten in Office und erleichtert Ihnen die Arbeit erheblich

  • Aktivieren Sie das Bearbeiten und Lesen von Registerkarten in Word, Excel und PowerPoint, Publisher, Access, Visio und Project.
  • Öffnen und erstellen Sie mehrere Dokumente in neuen Registerkarten desselben Fensters und nicht in neuen Fenstern.
  • Steigert Ihre Produktivität um 50 % und reduziert jeden Tag Hunderte von Mausklicks für Sie!
officetab unten

 

 

Kommentare (13)
Noch keine Bewertungen. Bewerten Sie als Erster!
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Wenn ich den Diagrammnamen eingebe, wird die Mail nicht generiert, das Dialogfeld wird einfach geschlossen. Haben Sie eine Idee, was ich falsch gemacht habe? Ich habe jeden Schritt befolgt
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Das Problem ist, dass wir keine Namen für Diagrammobjekte wie Tabellen festlegen können. Sie müssen die Integer-ID übergeben, um zu funktionieren. Wenn Sie beispielsweise nur 1 Diagramm in "Sheet1" haben, versuchen Sie, den Wert 1 zu übergeben, wenn die msgbox angezeigt wird.

PS: Entschuldigung für das schlechte Englisch :]
Dieser Kommentar wurde vom Moderator auf der Website minimiert
hola como puede enviar por correo, una tabla dinámica, y no un grafico
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Fehler im Code: "\") + 1) & "" " width=700 height=50Im fettgedruckten Text sollte das mittlere ein einzelnes Anführungszeichen sein

Dieser Kommentar wurde vom Moderator auf der Website minimiert
Es enthält das Diagramm als Anhang. Haben Sie eine Idee, wie Sie es als Bild in den E-Mail-Text selbst einfügen können? Danke Yousef
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Gleiches Problem, Lösung?
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo J,
Der Code wurde aktualisiert. Bitte versuchen Sie es. Entschuldigung für die Unannehmlichkeiten.


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
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo,
mi nic sie nie załącza, czy coś tutaj należałoby wpisać jeszcze?
xPath = "co tutaj trzeba wprowadzić?"
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo Kuba,
Bitte entfernen Sie die / eintragen <img src="/.
Der Fehler wird durch den Editor auf der Website verursacht.
Es tut uns leid.
Dieser Kommentar wurde vom Moderator auf der Website minimiert
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 als String
Dim xChartPath als String
Dim xPath als Zeichenfolge
Dim xChart als ChartObject
On Error Resume Next
Dim wydzialy als Schnur
wydzialy = lista.Zellen (3, 75)
xChartName = Application.InputBox(wydzialy, "KuTools for Excel", , , , , , 2) 'Wykres1 '"Bitte geben Sie den Diagrammnamen ein:"
Wenn xChartName = "" dann Sub beenden
Setzen Sie xChart = Sheets("Wykresy").ChartObjects(xChartName) 'Ändern Sie "Sheet1" in Ihren Arbeitsblattnamen
Wenn xChart nichts ist, dann beenden Sie Sub
xChartPath = Application.ActiveWorkbook.Path & "\" & Environ("USERNAME") & VBA.Format(VBA.Now(), "DD_MM_YY_HH_MM_SS") & ".svg" '.bmp '.svg '.svg ma lepsza jakość
xPfad = " "
xChart.Chart.Export xChartPath


Dim OutApp als Objekt
OutMail als Objekt dimmen
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Mit OutMail
.To = E-Mails(b)
.CC = emails_dw(b)
.Subject = "XXXX" ' - " & lista.Cells(i, 66)
.Anhänge.xChartPath hinzufügen
.HTMLBody = "treść" & xPath

Setze .SendUsingAccount = OutApp.Session.Accounts.Item(1)

.Anzeige
Ende mit
Töten Sie xChartPath
Setzen Sie OutMail = Nichts
Setze OutApp = Nichts
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo Kuba,
Der Code wurde aktualisiert. Der Empfänger kann das Diagramm normal anzeigen. Bitte versuchen Sie es.
Hinweis: Bitte ändern Sie im Code das "Diagramm 1" an Ihren eigenen Diagrammnamen. Geben Sie die E-Mail-Adresse im Feld An an.
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
Dieser Kommentar wurde vom Moderator auf der Website minimiert
HALLO, ich möchte Platz im E-Mail-Text hinzufügen, welches Schlüsselwort soll ich verwenden.
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo pavan chougule,
Die folgenden zwei Zeilen im Code enthalten den Inhalt des E-Mail-Texts. Sie können den E-Mail-Text manuell ändern, indem Sie die Leertaste auf Ihrer Tastatur drücken, um ein Leerzeichen hinzuzufügen.
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>"
Es sind noch keine Kommentare vorhanden
Hinterlassen Sie Ihre Kommentare
Als Gast posten
×
Bewerte diese Nachricht:
0   Figuren
Vorgeschlagene Standorte

Folgen Sie uns

Copyright © 2009 - www.extendoffice.com. | Alle Rechte vorbehalten. Unterstützt von ExtendOffice. | Sitemap
Microsoft und das Office-Logo sind Marken oder eingetragene Marken der Microsoft Corporation in den USA und / oder anderen Ländern.
Geschützt durch Sectigo SSL