Note: The other languages of the website are Google-translated. Back to English
Přihlásit se Registrace

Jak poslat konkrétní graf v e-mailu s VBA v aplikaci Excel?

Možná víte, jak odeslat e-mail prostřednictvím aplikace Outlook v aplikaci Excel s kódem VBA. Víte však, jak připojit konkrétní graf v určitém listu do těla e-mailu? Tento článek vám ukáže způsob řešení tohoto problému.

Odeslat konkrétní graf v e-mailu v aplikaci Excel s kódem VBA

Odeslat konkrétní graf v e-mailu v aplikaci Excel s kódem VBA

Chcete-li odeslat konkrétní graf v e-mailu s kódem VBA v aplikaci Excel, postupujte takto.

1. V listu obsahujícím graf, který chcete připojit v těle e-mailu, stiskněte Další + F11 klávesy pro otevření Microsoft Visual Basic pro aplikace okno.

2. V Microsoft Visual Basic pro aplikace okno, klikněte prosím Vložit > Modul. Poté zkopírujte níže uvedený kód VBA do okna Kód.

Kód VBA: Odeslání konkrétního grafu v e-mailu v aplikaci 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

Poznámka: V kódu prosím změňte v řádku e-mailovou adresu příjemce a předmět e-mailu .To = "xrr@163.com" a vedení .Subject = "Přidat graf do těla pošty aplikace Outlook" , Sheet1 je list obsahující graf, který chcete odeslat, změňte jej prosím na svůj vlastní.

3. zmáčkni F5 klíč ke spuštění kódu. V otvoru Kutools pro Excel V dialogovém okně zadejte název grafu, který připojíte do těla e-mailu, a poté klikněte na ikonu OK knoflík. Viz screenshot:

Poté se automaticky vytvoří e-mail se zadaným grafem zobrazeným v těle e-mailu, jak je ukázáno níže. Kliknutím na tlačítko Odeslat odešlete tento e-mail.

Související články:

 

 

 

Nejlepší kancelářské nástroje produktivity

Kutools pro Excel řeší většinu vašich problémů a zvyšuje vaši produktivitu o 80%

  • Opakované použití: Rychle vložte složité vzorce, grafy a cokoli, co jste dříve používali; Šifrovat buňky s heslem; Vytvořte seznam adresátů a posílat e-maily ...
  • Super Formula Bar (snadno upravit více řádků textu a vzorce); Rozložení pro čtení (snadno číst a upravovat velké množství buněk); Vložit do filtrovaného rozsahu...
  • Sloučit buňky / řádky / sloupce bez ztráty dat; Rozdělit obsah buněk; Zkombinujte duplicitní řádky / sloupce... Zabraňte duplicitním buňkám; Porovnat rozsahy...
  • Vyberte možnost Duplikovat nebo Jedinečný Řádky; Vyberte prázdné řádky (všechny buňky jsou prázdné); Super hledání a fuzzy hledání v mnoha sešitech; Náhodný výběr ...
  • Přesná kopie Více buněk beze změny odkazu na vzorec; Automaticky vytvářet reference do více listů; Vložte odrážky, Zaškrtávací políčka a další ...
  • Extrahujte text, Přidat text, Odebrat podle pozice, Odebrat mezeru; Vytváření a tisk mezisoučtů stránkování; Převod mezi obsahem buněk a komentáři...
  • Super filtr (uložit a použít schémata filtrů na jiné listy); Rozšířené řazení podle měsíce / týdne / dne, frekvence a dalších; Speciální filtr tučnou kurzívou ...
  • Kombinujte sešity a pracovní listy; Sloučit tabulky na základě klíčových sloupců; Rozdělte data do více listů; Dávkový převod xls, xlsx a PDF...
  • Více než 300 výkonných funkcí. Podporuje Office / Excel 2007-2021 a 365. Podporuje všechny jazyky. Snadné nasazení ve vašem podniku nebo organizaci. Plné funkce 30denní bezplatná zkušební verze. 60denní záruka vrácení peněz.
karta kte 201905

Office Tab přináší do Office rozhraní s kartami a usnadňuje vám práci

  • Povolte úpravy a čtení na kartách ve Wordu, Excelu, PowerPointu, Publisher, Access, Visio a Project.
  • Otevřete a vytvořte více dokumentů na nových kartách ve stejném okně, nikoli v nových oknech.
  • Zvyšuje vaši produktivitu o 50%a snižuje stovky kliknutí myší každý den!
officetab dno

 

 

Komentáře (13)
Zatím žádné hodnocení. Buďte první, kdo ohodnotí!
Leigh
Leigh
Tento komentář byl moderátorem webu minimalizován
když zadám název grafu, pošta nevygeneruje dialogové okno, jen se zavře, máte ponětí, co jsem udělal špatně? Sledoval jsem každý krok
odpověď
0
0
Borges
Borges     Leigh
Tento komentář byl moderátorem webu minimalizován
Problém je v tom, že nemůžeme nastavit názvy pro objekty grafu, jako jsou tabulky. Chcete-li pracovat, musíte předat celé číslo ID. Například, pokud máte pouze 1 graf v "Sheet1", zkuste předat hodnotu 1, když se zobrazí msgbox.

PS: omlouvám se za špatnou angličtinu :]
odpověď
0
0
Aaron Manqueo
Aaron Manqueo
Tento komentář byl moderátorem webu minimalizován
hola como puede enviar por correo, una tabla dinámica, y no un gráfico
odpověď
0
0
Nitin Sharma
Nitin Sharma
Tento komentář byl moderátorem webu minimalizován
V kódu je chyba: "\") + 1) & "" " width=700 height=50Uprostřed tučného textu by měla být jedna čárka

odpověď
0
0
Yousef
Yousef
Tento komentář byl moderátorem webu minimalizován
Graf obsahuje jako přílohu. Máte představu, jak to zahrnout jako obrázek do samotného těla pošty? Děkuji, Youssef
odpověď
0
0
J
J     Yousef
Tento komentář byl moderátorem webu minimalizován
Stejný problém, nějaké řešení?
odpověď
0
0
krystal
krystal     J
Tento komentář byl moderátorem webu minimalizován
Ahoj J,
Kód byl aktualizován. Zkuste to prosím. Omluvám se za nepříjemnost.


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
odpověď
Zpráva
0
0
Kuba
Kuba     krystal
Tento komentář byl moderátorem webu minimalizován
Dobrý den,
mi nic sie nie załącza, czy coś tutaj należałoby wpisać jeszcze?
xPath = "co tutaj trzeba wprowadzić?"
odpověď
0
0
krystal
krystal     Kuba
Tento komentář byl moderátorem webu minimalizován
Ahoj Kubo,
Odeberte prosím / označit <img src="/.
Chyba je způsobena editorem na webu.
Omluvám se za nepříjemnost.
odpověď
Zpráva
0
0
Kuba
Kuba     krystal
Tento komentář byl moderátorem webu minimalizován
cześć, pełny kod działa tylko do momentu podglądu komunikatu, przy wysyłce adresat otrzymuje błąd i wykresu nie widać ("Nie je można wyświetlić połączonego obrazu. Plik mógł zostałąźawn je ukázaný przyznięzęzyę). 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 jako řetězec
Dim xChartPath jako řetězec
Dim xPath As String
Dim xChart jako ChartObject
On Error Resume Next
Dim wydzialy As String
wydzialy = lista.Cells(3, 75)
xChartName = Application.InputBox(wydzialy, "KuTools for Excel", , , , , , 2) 'Wykres1 '"Zadejte název grafu:"
If xChartName = "" Pak Exit Sub
Set xChart = Sheets("Wykresy").ChartObjects(xChartName) 'Změňte "Sheet1" na název vašeho listu
Pokud xChart není nic, pak Exit 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


Ztlumit OutApp jako objekt
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Nastavit OutMail = OutApp.CreateItem(0)
S OutMail
.To = e-maily(b)
.CC = emails_dw(b)
.Subject = "XXXX" ' - " & lista.Cells(i, 66)
.Přílohy.Přidat xChartPath
.HTMLBody = "treść" & xPath

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

.Zobrazit
Konec s
Zabijte xChartPath
Nastavte OutMail = nic
Nastavte OutApp = Nic
0
0
krystal
krystal     Kuba
Tento komentář byl moderátorem webu minimalizován
Ahoj Kubo,
Kód byl aktualizován. Příjemce může graf normálně zobrazit. Zkuste to prosím.
Poznámka: V kódu změňte „Graf 1" na svůj vlastní název grafu. A do pole Komu zadejte e-mailovou adresu.
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
odpověď
Zpráva
0
0
pavan chougule
pavan chougule
Tento komentář byl moderátorem webu minimalizován
AHOJ, chci přidat místo v těle pošty, které klíčové slovo mám použít.
odpověď
0
0
krystal
krystal     pavan chougule
Tento komentář byl moderátorem webu minimalizován
Ahoj pavan chougule,
Následující dva řádky v kódu obsahují obsah těla e-mailu. Tělo e-mailu můžete ručně upravit tak, že přidáte mezeru stisknutím mezerníku na klávesnici.
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>"
odpověď
Zpráva
0
0
Zatím zde nejsou žádné komentáře
Zanechat své připomínky
Host
Odesílání jako host
Přihlášení
×
Ohodnoťte tento příspěvek:
resetovat
0   Postavy
Doporučená umístění

Sociální sítě

Copyright © 2009 - www.extendoffice.com. | Všechna práva vyhrazena. Poháněno ExtendOffice. | |. | Sitemap
Microsoft a logo Office jsou ochranné známky nebo registrované ochranné známky společnosti Microsoft Corporation ve Spojených státech a / nebo jiných zemích.
Chráněno Sectigo SSL