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

Hvordan sendes et specifikt diagram i en e-mail med vba i Excel?

Du ved muligvis, hvordan du sender en e-mail via Outlook i Excel med VBA-kode. Men ved du, hvordan du vedhæfter et specifikt diagram i et bestemt regneark i e-mailens brødtekst? Denne artikel viser dig metoden til at løse dette problem.

Send et specifikt diagram i en e-mail i Excel med VBA-kode

Send et specifikt diagram i en e-mail i Excel med VBA-kode

Gør som følger for at sende et specifikt diagram i en e-mail med VBA-kode i Excel.

1. I regnearket indeholder det diagram, du vil vedhæfte i e-mail-kroppen, skal du trykke på andre + F11 nøgler til at åbne Microsoft Visual Basic til applikationer vindue.

2. i Microsoft Visual Basic til applikationer vindue, klik venligst indsatte > Moduler. Kopier derefter nedenunder VBA-kode til kodevinduet.

VBA-kode: Send et specifikt diagram i en e-mail 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

Bemærk: I koden skal du ændre modtagerens e-mail-adresse og e-mail-emnet på linjen .Til = "xrr@163.com" og linie .Subject = "Tilføj diagram i Outlook-posttekst" , Sheet1 er arket, der indeholder det diagram, du vil sende, skal du ændre det til dit eget.

3. Tryk på F5 nøgle for at køre koden. I åbningen Kutools til Excel dialogboksen, skal du indtaste navnet på det diagram, du vil vedhæfte i e-mail-brødteksten, og derefter klikke på OK knap. Se skærmbillede:

Derefter oprettes en e-mail automatisk med det angivne diagram vist i e-mail-kroppen som vist nedenstående skærmbillede. Klik på knappen Send for at sende denne e-mail.

Relaterede artikler:

 

 

 

De bedste Office-produktivitetsværktøjer

Kutools til Excel løser de fleste af dine problemer og øger din produktivitet med 80%

  • Genbruge: Indsæt hurtigt komplekse formler, diagrammer og alt, hvad du har brugt før; Krypter celler med adgangskode Opret postliste og send e-mails ...
  • Super formel bar (let redigere flere linjer med tekst og formel); Læsning Layout (let at læse og redigere et stort antal celler); Indsæt til filtreret rækkevidde...
  • Flet celler / rækker / kolonner uden at miste data; Split celler indhold; Kombiner duplikerede rækker / kolonner... Forhindre duplikerede celler; Sammenlign områder...
  • Vælg Duplicate eller Unique Rækker; Vælg tomme rækker (alle celler er tomme); Super Find og Fuzzy Find i mange arbejdsbøger; Tilfældig valg ...
  • Præcis kopi Flere celler uden at ændre formelreference; Auto Opret referencer til flere ark; Indsæt kugler, Afkrydsningsfelter og mere ...
  • Uddrag tekst, Tilføj tekst, Fjern efter position, Fjern mellemrum; Opret og udskriv personsøgningssubtotaler; Konverter mellem celler indhold og kommentarer...
  • Superfilter (gem og anvend filterskemaer på andre ark); Avanceret sortering efter måned / uge / dag, hyppighed og mere; Specielt filter af fed, kursiv ...
  • Kombiner arbejdsbøger og arbejdsark; Fletabeller baseret på nøglekolonner; Opdel data i flere ark; Batch Konverter xls, xlsx og PDF...
  • Mere end 300 kraftfulde funktioner. Understøtter Office / Excel 2007-2021 og 365. Understøtter alle sprog. Nem implementering i din virksomhed eller organisation. Fuld funktioner 30-dages gratis prøveperiode. 60 dages pengene tilbage garanti.
kte-fane 201905

Fanen Office bringer en grænseflade til et kontor med Office, og gør dit arbejde meget lettere

  • Aktiver redigering og læsning af faner i Word, Excel, PowerPoint, Publisher, Access, Visio og Project.
  • Åbn og opret flere dokumenter i nye faner i det samme vindue snarere end i nye vinduer.
  • Øger din produktivitet med 50 % og reducerer hundredvis af museklik for dig hver dag!
officetab bund

 

 

Sorter kommentarer efter
Ældste først
Nyeste først
Kommentarer (13)
Ingen vurderinger endnu. Vær den første til at bedømme!
Leigh
Leigh
Denne kommentar blev minimeret af moderatoren på webstedet
når jeg indtaster diagramnavnet genererer mailen ikke dialogboksen lukkes bare, nogen ide om hvad jeg har gjort forkert? Jeg har fulgt hvert trin
Svar
0
0
Borges
Borges     Leigh
Denne kommentar blev minimeret af moderatoren på webstedet
Problemet er, at vi ikke kan angive navne til diagramobjekter som tabeller. Du skal videregive heltals-id'et for at virke. For eksempel, hvis du kun har 1 diagram i "Sheet1", prøv at sende værdien 1, når msgbox dukker op.

PS: undskyld det dårlige engelsk :]
Svar
0
0
Aaron Manqueo
Aaron Manqueo
Denne kommentar blev minimeret af moderatoren på webstedet
hola como puede enviar por correo, una tabla dinámica, y no un gráfico
Svar
0
0
Nitin Sharma
Nitin Sharma
Denne kommentar blev minimeret af moderatoren på webstedet
Der er fejl i koden: "\") + 1) & "" " bredde=700 højde=50I den fed tekst skal den midterste være et enkelt omvendt komma

Svar
0
0
YOussef
YOussef
Denne kommentar blev minimeret af moderatoren på webstedet
Det inkluderer diagrammet som en vedhæftet fil. Har du nogen idé om, hvordan du kan inkludere det som et billede i selve mailens brødtekst. Tak, Youssef
Svar
0
0
J
J     YOussef
Denne kommentar blev minimeret af moderatoren på webstedet
Samme problem, nogen løsning?
Svar
0
0
krystal
krystal     J
Denne kommentar blev minimeret af moderatoren på webstedet
Hej J,
Koden er blevet opdateret. Prøv det. Beklager ulejligheden.


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
Svar
Rapport
0
0
Kuba
Kuba     krystal
Denne kommentar blev minimeret af moderatoren på webstedet
Hej,
mi nic sie nie załącza, czy coś tutaj należałoby wpisać jeszcze?
xPath = "co tutaj trzeba wprowadzić?"
Svar
0
0
krystal
krystal     Kuba
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Kuba,
Fjern venligst / tag ind <img src="/.
Fejlen er forårsaget af redaktøren på siden.
Undskyld ulejligheden.
Svar
Rapport
0
0
Kuba
Kuba     krystal
Denne kommentar blev minimeret af moderatoren på webstedet
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 du tak ktoś miał czy tylko du mnie taki zonk? Prosze o pomoc, tutaj kod, który dotyczy wykresum już tak mało brakuje :)

Dim xChartName Som streng
Dim xChartPath Som streng
Dim xPath som streng
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 '"Indtast venligst diagramnavnet:"
Hvis xChartName = "" Afslut Sub
Indstil xChart = Sheets("Wykresy").ChartObjects(xChartName) 'Skift "Sheet1" til dit regnearks navn
Hvis xChart ikke er noget, skal du afslutte Sub
xChartPath = Application.ActiveWorkbook.Path & "\" & Environ("BRUGERNAVN") & 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
Dæmp OutMail som objekt
Indstil OutApp = CreateObject("Outlook.Application")
Indstil OutMail = OutApp.CreateItem(0)
Med OutMail
.Til = e-mails(b)
.CC = emails_dw(b)
.Subject = "XXXX" ' - " & lista.Cells(i, 66)
.Attachments.Add xChartPath
.HTMLBody = "treść" & xPath

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

.Skærm
Slut med
Dræb xChartPath
Indstil OutMail = Intet
Indstil OutApp = Intet
0
0
krystal
krystal     Kuba
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Kuba,
Koden er blevet opdateret. Modtageren kan se diagrammet normalt. Prøv det.
Bemærk: I koden skal du ændre "Diagram 1" til dit eget diagramnavn. Og angiv e-mailadressen i feltet Til.
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
Svar
Rapport
0
0
pavan chougule
pavan chougule
Denne kommentar blev minimeret af moderatoren på webstedet
HEJ , jeg vil tilføje plads i mailens brødtekst , hvilket søgeord skal jeg bruge.
Svar
0
0
krystal
krystal     pavan chougule
Denne kommentar blev minimeret af moderatoren på webstedet
Hej pavan chougule,
De følgende to linjer i koden indeholder e-mailens brødtekst. Du kan manuelt ændre e-mail-brødteksten ved at trykke på mellemrumstasten på dit tastatur for at tilføje et mellemrum.
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>"
Svar
Rapport
0
0
Der er endnu ingen kommentarer her
Efterlad dine kommentarer
Gæst
Sender som gæst
Login
×
Bedøm dette indlæg:
Nulstil
0   Tegn
Foreslåede steder

Følg os

Copyright © 2009 - www.extendoffice.com. | Alle rettigheder forbeholdes. Drevet af ExtendOffice. | | Sitemap
Microsoft og Office-logoet er varemærker eller registrerede varemærker tilhørende Microsoft Corporation i USA og / eller andre lande.
Beskyttet af Sectigo SSL