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

Kako poslati določen grafikon v e-pošti z vba v Excelu?

Morda veste, kako poslati e-pošto prek Outlooka v Excelu s kodo VBA. Vendar, ali veste, kako v telo e-poštnega sporočila priložite določen grafikon na določen delovni list? Ta članek vam bo pokazal način reševanja te težave.

Pošljite določen grafikon v e-poštnem sporočilu v Excelu s kodo VBA


Pošljite določen grafikon v e-poštnem sporočilu v Excelu s kodo VBA

Naredite naslednje, če želite poslati določen grafikon v e-poštnem sporočilu s kodo VBA v Excelu.

1. Na delovnem listu je grafikon, ki ga želite priložiti v telo e-pošte, pritisnite druga + F11 tipke za odpiranje Microsoft Visual Basic za aplikacije okno.

2. V Ljubljani Microsoft Visual Basic za aplikacije okno, kliknite Vstavi > Moduli. Nato kopirajte spodnjo kodo VBA v okno Code.

Koda VBA: Pošljite določen grafikon v e-poštnem sporočilu v Excelu

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

Opombe: V kodi spremenite prejemnikov e-poštni naslov in zadevo e-pošte v vrstici .To = "xrr@163.com" in črta .Subject = "Dodaj grafikon v telo pošte Outlook" , Sheet1 je list, ki vsebuje grafikon, ki ga želite poslati, ga spremenite v svojega.

3. Pritisnite F5 tipko za zagon kode. V uvodu Kutools za Excel v pogovorno okno vnesite ime grafikona, ki ga boste priložili v telo e-pošte, in nato kliknite OK . Oglejte si posnetek zaslona:

Nato se e-poštno sporočilo samodejno ustvari z navedenim grafikonom, ki se prikaže v telesu e-pošte, kot je prikazano spodaj. Za pošiljanje tega e-poštnega sporočila kliknite gumb Pošlji.


Sorodni članki:

 

 

 


Najboljša orodja za pisarniško produktivnost

Kutools za Excel rešuje večino vaših težav in poveča vašo produktivnost za 80%

  • Ponovna uporaba: Hitro vstavite zapletene formule, grafikoni in vse, kar ste že uporabljali; Šifriraj celice z geslom; Ustvari poštni seznam in pošiljanje e-pošte ...
  • Vrstica Super Formula (enostavno urejanje več vrstic besedila in formule); Bralna postavitev (enostavno branje in urejanje velikega števila celic); Prilepite v filtrirani obseg...
  • Združi celice / vrstice / stolpce brez izgube podatkov; Vsebina razdeljenih celic; Združi podvojene vrstice / stolpce... prepreči podvojene celice; Primerjaj obsege...
  • Izberite Duplicate ali Unique Vrstice; Izberite prazne vrstice (vse celice so prazne); Super Find in Fuzzy Find v mnogih delovnih zvezkih; Naključna izbira ...
  • Natančna kopija Več celic brez spreminjanja sklica formule; Samodejno ustvarjanje referenc na več listov; Vstavi oznake, Potrditvena polja in še več ...
  • Izvleček besedila, Dodaj besedilo, Odstrani po položaju, Odstrani presledek; Ustvari in natisni vmesne seštevke strani Pretvarjanje med vsebino celic in komentarji...
  • Super filter (shranite in uporabite sheme filtrov za druge liste); Napredno razvrščanje glede na mesec / teden / dan, pogostost in drugo; Poseben filter s krepko, ležeče ...
  • Združite delovne zvezke in delovne liste; Spoji tabele na podlagi ključnih stolpcev; Razdelite podatke na več listov; Paketna pretvorba xls, xlsx in PDF...
  • Več kot 300 zmogljivih funkcij. Podpira Office / Excel 2007-2021 in 365. Podpira vse jezike. Enostavna uvedba v vašem podjetju ali organizaciji. 30-dnevna brezplačna preizkusna različica vseh funkcij. 60-dnevna garancija vračila denarja.
zavihek kte 201905

Kartica Office prinaša vmesnik z zavihki v Office in poenostavi vaše delo

  • Omogočite urejanje in branje z zavihki v Wordu, Excelu, PowerPointu, Publisher, Access, Visio in Project.
  • Odprite in ustvarite več dokumentov v novih zavihkih istega okna in ne v novih oknih.
  • Poveča vašo produktivnost za 50%in vsak dan zmanjša na stotine klikov miške za vas!
dno pisarniške mize

 

 

Komentarji (13)
Ocene še ni. Bodite prvi in ​​ocenite!
Ta komentar je moderator na spletnem mestu minimiziral
ko vnesem ime grafikona, e-pošta ne ustvari, se pogovorno okno samo zapre, se vam zdi, kaj sem naredil narobe? Sledil sem vsakemu koraku
Ta komentar je moderator na spletnem mestu minimiziral
Težava je v tem, da ne moremo nastaviti imen za predmete grafikonov, kot so tabele. Za delovanje morate posredovati celoštevilski ID. Na primer, če imate v "Sheet1" samo 1 grafikon, poskušate posredovati vrednost 1, ko se prikaže sporočilo msgbox.

PS: oprosti za slabo angleščino :]
Ta komentar je moderator na spletnem mestu minimiziral
hola como puede enviar por correo, una tabla dinámica, y no un gráfico
Ta komentar je moderator na spletnem mestu minimiziral
V kodi je napaka: "\") + 1) & "" " width=700 height=50V krepkem besedilu mora biti srednja ena sama obrnjena vejica

Ta komentar je moderator na spletnem mestu minimiziral
Vključuje grafikon kot prilogo. Ali imate kakšno idejo, kako jo vključiti kot sliko v samo telo pošte. Hvala, Youssef
Ta komentar je moderator na spletnem mestu minimiziral
Ista težava, kakšna rešitev?
Ta komentar je moderator na spletnem mestu minimiziral
Živjo J,
Koda je posodobljena. Prosim poskusite. Oprostite za nevšečnosti.


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
Ta komentar je moderator na spletnem mestu minimiziral
Cześć,
mi nic sie nie załącza, czy coś tutaj należałoby wpisać jeszcze?
xPath = "co tutaj trzeba wprowadzić?"
Ta komentar je moderator na spletnem mestu minimiziral
Živjo Kuba,
Prosimo, odstranite / označite <img src="/.
Napako je povzročil urejevalnik spletnega mesta.
Oprostite za nevšečnosti.
Ta komentar je moderator na spletnem mestu minimiziral
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 malo brakuje :)

Dim xChartName kot niz
Zatemni xChartPath kot niz
Dim xPath kot niz
Zatemni xChart kot ChartObject
On Error Resume Next
Dim wydzialy As String
wydzialy = lista.Cells(3, 75)
xChartName = Application.InputBox(wydzialy, "KuTools for Excel", , , , , , 2) 'Wykres1 '"Prosimo, vnesite ime grafikona:"
If xChartName = "" Potem Izhod Sub
Set xChart = Sheets("Wykresy").ChartObjects(xChartName) 'Spremeni "Sheet1" v ime svojega delovnega lista
Če xChart ni nič, potem zapustite 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


Zatemnite OutApp kot objekt
Zatemni OutMail kot predmet
Nastavi OutApp = CreateObject("Outlook.Application")
Nastavi OutMail = OutApp.CreateItem(0)
Z OutMail
.Za = e-pošta(b)
.CC = emails_dw(b)
.Subject = "XXXX" ' - " & lista.Cells(i, 66)
.Attachments.Add xChartPath
.HTMLBody = "treść" & xPath

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

.Prikaz
Končaj s
Ubijte xChartPath
Nastavite OutMail = Nič
Nastavite OutApp = Nič
Ta komentar je moderator na spletnem mestu minimiziral
Živjo Kuba,
Koda je posodobljena. Prejemnik si lahko normalno ogleda grafikon. Prosim poskusite.
Opombe: V kodi spremenite "Graf 1" v svoje lastno ime grafikona. In vnesite e-poštni naslov v polje Za.
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
Ta komentar je moderator na spletnem mestu minimiziral
POZDRAVLJENI, želim dodati prostor v telo pošte, katero ključno besedo naj uporabim.
Ta komentar je moderator na spletnem mestu minimiziral
Živjo pavan chougule,
Naslednji dve vrstici v kodi vsebujeta vsebino telesa e-pošte. Telo e-pošte lahko ročno spremenite tako, da pritisnete preslednico na tipkovnici, da dodate presledek.
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>"
Tu še ni objavljenih komentarjev
Pustite vaše komentarje
Objava kot gost
×
Ocenite to objavo:
0   Znaki
Predlagane lokacije

Sledi nam

Copyright © 2009 - www.extendoffice.com. | Vse pravice pridržane. Poganja ga ExtendOffice. | Kazalo
Microsoft in logotip Office sta blagovni znamki ali registrirani blagovni znamki družbe Microsoft Corporation v ZDA in / ali drugih državah.
Zaščiteno s Sectigo SSL