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

Hogyan küldhetünk egy adott diagramot egy e-mailben az vba-val az Excelben?

Lehet, hogy tudsz e-mailt küldeni az Outlook programban az Excel programban VBA kóddal. Tudja azonban, hogyan csatolhat egy adott táblázatot egy bizonyos munkalapon az e-mail törzséhez? Ez a cikk bemutatja a probléma megoldásának módszerét.

Küldjön egy adott diagramot egy e-mailben az Excelben, VBA kóddal


Küldjön egy adott diagramot egy e-mailben az Excelben, VBA kóddal

Kérjük, tegye a következőket, ha egy adott diagramot szeretne elküldeni e-mailben VBA kóddal az Excel programban.

1. A munkalap tartalmazza az e-mail törzséhez csatolni kívánt diagramot, és nyomja meg a gombot más + F11 billentyűk megnyitásához Microsoft Visual Basic for Applications ablak.

2. Ban,-ben Microsoft Visual Basic for Applications ablakot, kérjük kattintson betétlap > Modulok. Ezután másolja a VBA kód alatt a Kód ablakba.

VBA kód: Egy adott diagram elküldése e-mailben az Excel programban

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

Megjegyzések: Kérjük, a kódban változtassa meg a címzett e-mail címét és az e-mail tárgyát a sorban .To = "xrr@163.com" és a vonal .Subject = "Diagram hozzáadása az Outlook levelező törzsében" , Sheet1 az a lap, amely tartalmazza az elküldeni kívánt táblázatot, kérjük, változtassa meg sajátjával.

3. megnyomni a F5 gombot a kód futtatásához. A megnyitón Kutools az Excel számára párbeszédpanelen írja be a csatolni kívánt diagram nevét az e-mail törzsébe, majd kattintson a gombra OK gomb. Lásd a képernyőképet:

Ezután automatikusan létrejön egy e-mail, a megadott diagram az e-mail törzsében jelenik meg, az alábbi képernyőképen. Az e-mail elküldéséhez kattintson a Küldés gombra.


Kapcsolódó cikkek:

 

 

 


A legjobb irodai termelékenységi eszközök

A Kutools for Excel megoldja a legtöbb problémát, és 80% -kal növeli a termelékenységet

  • újrafelhasználás: Gyorsan helyezze be összetett képletek, diagramok és bármi, amit korábban használt; Cellák titkosítása jelszóval; Levelezőlista létrehozása és e-maileket küldeni ...
  • Szuper Formula Bár (könnyedén szerkeszthet több szöveget és képletet); Olvasás elrendezés (könnyen olvasható és szerkeszthető nagyszámú cella); Beillesztés a Szűrt tartományba...
  • Cellák / sorok / oszlopok egyesítése az adatok elvesztése nélkül; Osztott cellák tartalma; Kombinálja a duplikált sorokat / oszlopokat... megakadályozza az ismétlődő cellákat; Hasonlítsa össze a tartományokat...
  • Válassza a Másolat vagy az Egyedi lehetőséget Sorok; Válassza az Üres sorok lehetőséget (az összes cella üres); Super Find és Fuzzy Find sok munkafüzetben; Véletlenszerű kiválasztás ...
  • Pontos másolás Több cella a képletreferencia megváltoztatása nélkül; Automatikus referenciák létrehozása több lapra; Helyezze be a golyókat, Jelölőnégyzetek és még sok más ...
  • Kivonat szöveg, Szöveg hozzáadása, Eltávolítás pozíció szerint, Hely eltávolítása; Hozz létre és nyomtasson személyhívó részösszegeket; Konvertálás a cellatartalom és a megjegyzések között...
  • Szuper szűrő (mentse el és alkalmazza a szűrősémákat más lapokra); Haladó rendezés hónap / hét / nap, gyakoriság és egyebek szerint; Speciális szűrő félkövér, dőlt betűvel ...
  • Kombinálja a munkafüzeteket és a munkalapokat; Táblázatok egyesítése kulcsoszlopok alapján; Az adatok felosztása több lapra; Kötegelt konvertálás xls, xlsx és PDF...
  • Több mint 300 hatékony funkció. Támogatja az Office / Excel 2007-2021 és 365 verziókat. Minden nyelvet támogat. Könnyű üzembe helyezés vállalatában vagy szervezetében. Teljes funkciók 30 napos ingyenes próbaverzió. 60 napos pénzvisszafizetési garancia.
kte lap 201905

Az Office fül a füles felületet hozza az Office-ba, és sokkal könnyebbé teszi a munkáját

  • Füles szerkesztés és olvasás engedélyezése Wordben, Excelben és PowerPointban, Publisher, Access, Visio és Project.
  • Több dokumentum megnyitása és létrehozása ugyanazon ablak új lapjain, mint új ablakokban.
  • 50% -kal növeli a termelékenységet, és naponta több száz kattintással csökkenti az egér kattintását!
officetab alja

 

 

A megjegyzések rendezése szerint
Hozzászólások (13)
Még nincs értékelés. Legyen Ön az első, aki értékel!
A weboldal moderátora ezt a megjegyzést minimalizálta
amikor beírom a diagram nevét, a levél nem generál, a párbeszédpanel csak bezárul, van ötleted, hogy mit csináltam rosszul? Minden lépést követtem
A weboldal moderátora ezt a megjegyzést minimalizálta
A probléma az, hogy nem tudunk nevet adni a diagramobjektumoknak, például a tábláknak. A munkához át kell adnia az egész azonosítót. Például, ha csak 1 diagramja van az „1. ​​lapon”, próbálja meg átadni az 1-es értéket, amikor megjelenik az msgbox.

PS: elnézést a rossz angolért :]
A weboldal moderátora ezt a megjegyzést minimalizálta
hola como puede enviar por correo, una tabla dinámica, y no un gráfico
A weboldal moderátora ezt a megjegyzést minimalizálta
Hiba van a kódban: "\") + 1) & "" " szélesség = 700 magasság = 50 A félkövér szövegben a középső egyetlen fordított vessző legyen

A weboldal moderátora ezt a megjegyzést minimalizálta
Mellékletként tartalmazza a diagramot. Van valami ötleted, hogyan lehet képként beilleszteni a levél törzsébe? Köszönöm, Youssef
A weboldal moderátora ezt a megjegyzést minimalizálta
Ugyanaz a probléma, valami megoldás?
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia J!
A kód frissítve lett. Kérjük, próbálja ki. Elnézést a kellemetlenségért.


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
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia,
mi nic sie nie załącza, czy coś tutaj należałoby wpisać jeszcze?
xPath = "co tutaj trzeba wprowadzić?"
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Kuba,
Kérjük, távolítsa el a / tag be <img src="/.
A hibát a webhely szerkesztője okozza.
Elnézést a kellemetlenségért.
A weboldal moderátora ezt a megjegyzést minimalizálta
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 As String
Dim xChartPath karakterláncként
Dim xPath As String
Dim xChart As ChartObject
On Error Resume Next
Dim wydzialy As String
wydzialy = lista.Cells(3, 75)
xChartName = Application.InputBox(wydzialy, "KuTools for Excel", , , , , , 2) 'Wykres1 '"Kérjük, adja meg a diagram nevét:"
Ha xChartName = "" Akkor lépjen ki a Sub
Állítsa be az xChart = Sheets("Wykresy").ChartObjects(xChartName) 'Módosítsa a "Sheet1" értéket a munkalap nevére
Ha az xChart semmi, akkor lépjen ki a Subból
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 mint objektum
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
OutMail beállítása = OutApp.CreateItem(0)
OutMail segítségével
.Címzett = e-mailek(b)
.CC = emails_dw(b)
.Subject = "XXXX" ' - " & lista.Cells(i, 66)
.Attachments.Add xChartPath
.HTMLBody = "treść" & xPath

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

.Kijelző
Vége
Öld meg az xChartPath-t
Set OutMail = Semmi
OutApp beállítása = Semmi
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Kuba,
A kód frissítve lett. A címzett normál módon tekintheti meg a diagramot. Kérjük, próbálja ki.
Megjegyzések: A kódban módosítsa a "1 diagram" a saját diagramnevére. Adja meg az e-mail címet a Címzett mezőben.
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
A weboldal moderátora ezt a megjegyzést minimalizálta
HELLO! Szeretnék helyet adni a levél törzsében, melyik kulcsszót használjam.
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Pavan Chougule!
A kód következő két sora tartalmazza az e-mail törzs tartalmát. Manuálisan módosíthatja az e-mail törzsét, ha megnyomja a szóköz billentyűt a billentyűzeten szóköz hozzáadásához.
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>"
Még senki sem írt megjegyzést
Hagyja meg észrevételeit
Feladás vendégként
×
Értékeld ezt a bejegyzést:
0   Karakterek
Javasolt helyek

Kövess minket

Copyright © 2009 - www.extendoffice.com. | Minden jog fenntartva. Powered by ExtendOffice. | Oldaltérkép
A Microsoft és az Office logó a Microsoft Corporation védjegyei vagy bejegyzett védjegyei az Egyesült Államokban és / vagy más országokban.
Sectigo SSL védi