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

Hur skickar jag ett specifikt diagram i ett e-postmeddelande med vba i Excel?

Du kanske vet hur du skickar ett e-postmeddelande via Outlook i Excel med VBA-kod. Men vet du hur du bifogar ett visst diagram i ett visst kalkylblad i e-postens kropp? Denna artikel kommer att visa dig metoden för att lösa detta problem.

Skicka ett specifikt diagram i ett e-postmeddelande i Excel med VBA-kod


Skicka ett specifikt diagram i ett e-postmeddelande i Excel med VBA-kod

Gör så här för att skicka ett specifikt diagram i ett e-postmeddelande med VBA-kod i Excel.

1. I kalkylbladet innehåller diagrammet du vill bifoga i e-posttexten, tryck på andra + F11 nycklar för att öppna Microsoft Visual Basic för applikationer fönster.

2. I Microsoft Visual Basic för applikationer klicka på fönstret Insert > Modulerna. Kopiera sedan VBA-koden nedan till kodfönstret.

VBA-kod: Skicka ett specifikt diagram i ett e-postmeddelande i 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

Anmärkningar: Ändra mottagarens e-postadress och e-postens ämne i koden i koden .To = "xrr@163.com" och linje .Subject = "Lägg till diagram i Outlook-e-posttexten" , Sheet1 är arket som innehåller diagrammet du vill skicka, ändra det till ditt eget.

3. tryck på F5 för att köra koden. I öppningen Kutools för Excel dialogrutan, ange namnet på diagrammet som du ska bifoga i e-posttexten och klicka sedan på OK knapp. Se skärmdump:

Sedan skapas ett e-postmeddelande automatiskt med det angivna diagrammet som visas i e-postkroppen som visas nedan. Klicka på knappen Skicka för att skicka detta e-postmeddelande.


Relaterade artiklar:

 

 

 


De bästa Office-produktivitetsverktygen

Kutools för Excel löser de flesta av dina problem och ökar din produktivitet med 80%

  • återanvändning: Sätt snabbt i komplexa formler, diagram och allt som du har använt tidigare; Kryptera celler med lösenord; Skapa e-postlista och skicka e-post ...
  • Super Formula Bar (enkelt redigera flera rader med text och formel); Läslayout (enkelt läsa och redigera ett stort antal celler); Klistra in i filtrerat intervall...
  • Sammanfoga celler / rader / kolumner utan att förlora data; Delat cellinnehåll; Kombinera duplicerade rader / kolumner... Förhindra duplicerade celler; Jämför intervall...
  • Välj Duplicera eller Unikt Rader; Välj tomma rader (alla celler är tomma); Super Find och Fuzzy Find i många arbetsböcker; Slumpmässigt val ...
  • Exakt kopia Flera celler utan att ändra formelreferens; Skapa referenser automatiskt till flera ark; Sätt in kulor, Kryssrutor och mer ...
  • Extrahera text, Lägg till text, ta bort efter position, Ta bort mellanslag; Skapa och skriva ut personsökningstalsatser; Konvertera mellan celler innehåll och kommentarer...
  • Superfilter (spara och tillämpa filterscheman på andra ark); Avancerad sortering efter månad / vecka / dag, frekvens och mer; Specialfilter av fet, kursiv ...
  • Kombinera arbetsböcker och arbetsblad; Sammanfoga tabeller baserat på nyckelkolumner; Dela data i flera ark; Batchkonvertera xls, xlsx och PDF...
  • Mer än 300 kraftfulla funktioner. Stöder Office / Excel 2007-2021 och 365. Stöder alla språk. Enkel implementering i ditt företag eller organisation. Fullständiga funktioner 30 dagars gratis provperiod. 60 dagars pengarna tillbaka-garanti.
kte-flik 201905

Fliken Office ger ett flikgränssnitt till Office och gör ditt arbete mycket enklare

  • Aktivera flikredigering och läsning i Word, Excel, PowerPoint, Publisher, Access, Visio och Project.
  • Öppna och skapa flera dokument i nya flikar i samma fönster, snarare än i nya fönster.
  • Ökar din produktivitet med 50 % och minskar hundratals musklick för dig varje dag!
officetab botten

 

 

Sortera kommentarer efter
Kommentarer (13)
Inga betyg än. Bli först med att betygsätta!
Denna kommentar minimerades av moderatoren på webbplatsen
När jag anger diagramnamnet genereras inte e-postmeddelandet, dialogrutan stängs bara, någon aning om vad jag har gjort för fel? Jag har följt varje steg
Denna kommentar minimerades av moderatoren på webbplatsen
Problemet är att vi inte kan ange namn för diagramobjekt som tabeller. Du måste skicka ett heltals-ID för att fungera. Till exempel, om du bara har ett diagram i "Sheet1", försöker du skicka värdet 1 när meddelanderutan dyker upp.

PS: förlåt för dålig engelska :]
Denna kommentar minimerades av moderatoren på webbplatsen
hola como puede enviar por correo, una tabla dinámica, y no un gráfico
Denna kommentar minimerades av moderatoren på webbplatsen
Det finns fel i koden: "\") + 1) & """ bredd=700 höjd=50I den fetstilta texten ska den mittersta vara ett enda inverterat kommatecken

Denna kommentar minimerades av moderatoren på webbplatsen
Den inkluderar diagrammet som en bilaga. Har du någon aning om hur man kan ta med den som bild i själva brevet. Tack, Youssef
Denna kommentar minimerades av moderatoren på webbplatsen
Samma problem, någon lösning?
Denna kommentar minimerades av moderatoren på webbplatsen
hej J,
Koden har uppdaterats. Vänligen ge det ett försök. Beklagar olägenheten.


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
Denna kommentar minimerades av moderatoren på webbplatsen
Hej!
mi nic sie nie załącza, czy coś tutaj należałoby wpisać jeszcze?
xPath = "co tutaj trzeba wprowadzić?"
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Kuba,
Ta bort / tagga in <img src="/.
Felet orsakas av redaktören på sajten.
Beklagar olägenheten.
Denna kommentar minimerades av moderatoren på webbplatsen
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 Var 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 Som sträng
Dim xChartPath som sträng
Dim xPath som sträng
Dim xChart Som ChartObject
On Error Resume Next
Dim wydzialy As String
wydzialy = lista.Cells(3, 75)
xChartName = Application.InputBox(wydzialy, "KuTools for Excel", , , , , , 2) 'Wykres1 '"Ange diagramnamnet:"
Om xChartName = "" Avsluta Sub
Ställ in xChart = Sheets("Wykresy").ChartObjects(xChartName) 'Ändra "Sheet1" till ditt kalkylbladsnamn
Om xChart är ingenting, avsluta Sub
xChartPath = Application.ActiveWorkbook.Path & "\" & Environ("USERNAME") & VBA.Format(VBA.Now(), "DD_MM_YY_HH_MM_SS") & ".svg" '.bmp '.svg '.svg ma lepsza jakość
xPath = " "
xChart.Chart.Export xChartPath


Dim OutApp som objekt
Dim OutMail som objekt
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Med OutMail
.Till = e-post(b)
.CC = emails_dw(b)
.Subject = "XXXX" ' - " & lista.Cells(i, 66)
.Attachments.Add xChartPath
.HTMLBody = "treść" & xPath

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

.Visa
Sluta med
Döda xChartPath
Ange OutMail = Ingenting
Ställ in OutApp = Ingenting
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Kuba,
Koden har uppdaterats. Mottagaren kan se diagrammet normalt. Vänligen ge det ett försök.
Anmärkningar: I koden, vänligen ändra "Diagram 1" till ditt eget diagramnamn. Och ange e-postadressen i fältet Till.
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
Denna kommentar minimerades av moderatoren på webbplatsen
HEJ , jag vill lägga till utrymme i e-posttexten , vilket nyckelord ska jag använda.
Denna kommentar minimerades av moderatoren på webbplatsen
Hej pavan chougule,
Följande två rader i koden innehåller e-postmeddelandets innehåll. Du kan manuellt ändra e-postmeddelandet genom att trycka på mellanslagstangenten på tangentbordet för att lägga till ett mellanslag.
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>"
Det finns inga kommentarer här ännu
Lämna dina kommentarer
Postar som gäst
×
Betygsätt detta inlägg:
0   Tecken
Föreslagna platser

Följ oss

Copyright © 2009 - www.extendoffice.com. | Alla rättigheter förbehållna. Drivs av ExtendOffice. | | Sitemap
Microsoft och Office-logotypen är varumärken eller registrerade varumärken som tillhör Microsoft Corporation i USA och / eller andra länder.
Skyddad av Sectigo SSL