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

Come inviare un grafico specifico in un'e-mail con vba in Excel?

Potresti sapere come inviare un'e-mail tramite Outlook in Excel con codice VBA. Tuttavia, sai come allegare un grafico specifico in un determinato foglio di lavoro nel corpo dell'email? Questo articolo ti mostrerà il metodo per risolvere questo problema.

Invia un grafico specifico in un'e-mail in Excel con codice VBA


Invia un grafico specifico in un'e-mail in Excel con codice VBA

Si prega di fare quanto segue per inviare un grafico specifico in un'e-mail con codice VBA in Excel.

1. Nel foglio di lavoro che contiene il grafico che si desidera allegare al corpo dell'e-mail, premere il tasto altro + F11 chiavi per aprire il Microsoft Visual Basic, Applications Edition finestra.

2. Nel Microsoft Visual Basic, Applications Edition finestra, fare clic inserire > Modulo. Quindi copia sotto il codice VBA nella finestra del codice.

Codice VBA: invia un grafico specifico in un'e-mail in 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

Note:: Nel codice, modificare l'indirizzo e-mail del destinatario e l'oggetto dell'e-mail in linea .To = "xrr@163.com" e la linea .Subject = "Aggiungi grafico nel corpo della posta di Outlook" , Sheet1 è il foglio che contiene il grafico che vuoi inviare, per favore cambialo con il tuo.

3. premi il F5 chiave per eseguire il codice. In apertura Kutools for Excel finestra di dialogo, immettere il nome del grafico da allegare nel corpo dell'e-mail, quindi fare clic su OK pulsante. Vedi screenshot:

Quindi viene creata automaticamente un'e-mail con il grafico specificato visualizzato nel corpo dell'e-mail come mostrato nell'immagine sottostante. Fare clic sul pulsante Invia per inviare questa email.


Articoli correlati:

 

 

 


I migliori strumenti per la produttività in ufficio

Kutools per Excel risolve la maggior parte dei tuoi problemi e aumenta la tua produttività dell'80%

  • Riutilizzo: Inserisci rapidamente formule complesse, grafici e tutto ciò che hai usato prima; Crittografa celle con password; Crea mailing list e invia email ...
  • Bar Super Formula (modifica facilmente più righe di testo e formula); Layout di lettura (leggi e modifica facilmente un gran numero di celle); Incolla su intervallo filtrato...
  • Unisci celle / righe / colonne senza perdere dati; Contenuto delle celle divise; Combina righe / colonne duplicate... Impedisci celle duplicate; Confronta intervalli...
  • Seleziona Duplica o Unico Righe; Seleziona Righe vuote (tutte le celle sono vuote); Super Find e Fuzzy Find in molte cartelle di lavoro; Selezione casuale ...
  • Copia esatta Più celle senza modificare il riferimento della formula; Riferimenti di creazione automatica a più fogli; Inserisci punti elenco, Caselle di controllo e altro ...
  • Estrai testo, Aggiungi testo, Rimuovi per posizione, Rimuovi spazio; Creare e stampare totali parziali di paging; Converti contenuto e commenti tra celle...
  • Super filtro (salva e applica schemi di filtri ad altri fogli); Ordinamento avanzato per mese / settimana / giorno, frequenza e altro; Filtro speciale in grassetto, corsivo ...
  • Combina cartelle di lavoro e fogli di lavoro; Unisci tabelle in base a colonne chiave; Suddividi i dati in più fogli; Conversione in batch xls, xlsx e PDF...
  • Più di 300 potenti funzionalità. Supporta Office/Excel 2007-2021 e 365. Supporta tutte le lingue. Facile implementazione nella tua azienda o organizzazione. Funzionalità complete Prova gratuita di 30 giorni. Garanzia di rimborso di 60 giorni.
scheda kte 201905

Scheda Office porta l'interfaccia a schede a Office e semplifica notevolmente il lavoro

  • Abilita la modifica e la lettura a schede in Word, Excel, PowerPoint, Publisher, Access, Visio e Project.
  • Apri e crea più documenti in nuove schede della stessa finestra, piuttosto che in nuove finestre.
  • Aumenta la produttività del 50% e riduce ogni giorno centinaia di clic del mouse!
fondo officetab

 

 

Commenti (13)
Ancora nessuna valutazione. Puoi essere il primo a votare!
Questo commento è stato fatto dal moderatore sul sito
quando inserisco il nome del grafico, la posta non genera la finestra di dialogo si chiude, hai idea di cosa ho fatto di sbagliato? Ho seguito ogni passaggio
Questo commento è stato fatto dal moderatore sul sito
Il problema è che non possiamo impostare nomi per oggetti grafico come le tabelle. Devi passare l'ID intero per funzionare. Ad esempio, se hai solo 1 grafico nel "Foglio1", prova a passare il valore 1 quando viene visualizzato il msgbox.

PS: scusate il pessimo inglese :)
Questo commento è stato fatto dal moderatore sul sito
hola como puede enviar por correo, una tabla dinámica, y no un gráfico
Questo commento è stato fatto dal moderatore sul sito
C'è un errore nel codice: "\") + 1) & "" " larghezza=700 altezza=50Nel testo in grassetto quella centrale dovrebbe essere una singola virgoletta

Questo commento è stato fatto dal moderatore sul sito
Include la tabella come allegato. Hai idea di come includerlo come immagine nel corpo della posta stessa. Grazie, Youssef
Questo commento è stato fatto dal moderatore sul sito
Stesso problema, qualche soluzione?
Questo commento è stato fatto dal moderatore sul sito
Ciao J,
Il codice è stato aggiornato. Per favore, provalo. Ci dispiace per l'inconvenienza.


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
Questo commento è stato fatto dal moderatore sul sito
Ciao,
mi nic sie nie załącza, czy coś tutaj należałoby wpisać jeszcze?
xPath = "co tutaj trzeba wprowadzić?"
Questo commento è stato fatto dal moderatore sul sito
Ciao Kuba,
Si prega di rimuovere il / taggati <img src="/.
L'errore è causato dall'editor nel sito.
Ci scusiamo per l'inconveniente.
Questo commento è stato fatto dal moderatore sul sito
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 come stringa
Dim xChartPath come stringa
Dim xPath come stringa
Dim xChart come ChartObject
On Error Resume Next
Dim wydzialy come String
wydzialy = lista.Cells(3, 75)
xChartName = Application.InputBox(wydzialy, "KuTools for Excel", , , , , , 2) 'Wykres1 '"Inserisci il nome del grafico:"
Se xChartName = "" Quindi esci da Sub
Imposta xChart = Sheets("Wykresy").ChartObjects(xChartName) 'Cambia "Sheet1" con il nome del tuo foglio di lavoro
Se xChart non è niente, esci da Sub
xChartPath = Application.ActiveWorkbook.Path & "\" & Environ("USERNAME") & VBA.Format(VBA.Now(), "DD_MM_YY_HH_MM_SS") & ".svg" '.bmp '.svg '.svg ma lepsza jakość
xPercorso = " "
xChart.Chart.Export xChartPath


Dim OutApp come oggetto
Dim OutMail come oggetto
Imposta OutApp = CreateObject ("Outlook.Application")
Imposta OutMail = OutApp.CreateItem(0)
Con OutMail
.A = email(b)
.CC = email_dw(b)
.Subject = "XXXX" ' - " & lista.Cells(i, 66)
.Allegati.Aggiungi xChartPath
.HTMLBody = "treść" & xPath

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

.Schermo
Fine Con
Uccidi xChartPath
Imposta OutMail = Niente
Imposta OutApp = Niente
Questo commento è stato fatto dal moderatore sul sito
Ciao Kuba,
Il codice è stato aggiornato. Il destinatario può visualizzare il grafico normalmente. Per favore, provalo.
Note:: Nel codice, cambia "grafico 1" al nome del tuo grafico. E specifica l'indirizzo e-mail nel campo A.
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
Questo commento è stato fatto dal moderatore sul sito
CIAO, voglio aggiungere spazio nel corpo della mail, quale parola chiave dovrei usare.
Questo commento è stato fatto dal moderatore sul sito
Ciao Pavan Chougule,
Le due righe seguenti nel codice contengono il contenuto del corpo dell'email. Puoi modificare manualmente il corpo dell'email premendo il tasto barra spaziatrice sulla tastiera per aggiungere uno spazio.
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>"
Non ci sono ancora commenti pubblicati qui
Lasciate i vostri commenti
Pubblicazione come ospite
×
Valuta questo post:
0   Personaggi
Posizioni suggerite

Seguici

Copyright © 2009 - www.extendoffice.com. | Tutti i diritti riservati. Offerto da ExtendOffice, | Mappa del sito
Microsoft e il logo Office sono marchi o marchi registrati di Microsoft Corporation negli Stati Uniti e / o in altri paesi.
Protetto da Sectigo SSL