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

Πώς να στείλετε ένα συγκεκριμένο γράφημα σε ένα email με vba στο Excel;

Ίσως γνωρίζετε πώς να στείλετε ένα email μέσω του Outlook στο Excel με κωδικό VBA. Ωστόσο, γνωρίζετε πώς να επισυνάψετε ένα συγκεκριμένο γράφημα σε ένα συγκεκριμένο φύλλο εργασίας στο σώμα του μηνύματος ηλεκτρονικού ταχυδρομείου; Αυτό το άρθρο θα σας δείξει τη μέθοδο επίλυσης αυτού του προβλήματος.

Στείλτε ένα συγκεκριμένο γράφημα σε ένα email στο Excel με κωδικό VBA


Στείλτε ένα συγκεκριμένο γράφημα σε ένα email στο Excel με κωδικό VBA

Κάντε τα εξής για να στείλετε ένα συγκεκριμένο γράφημα σε ένα email με κωδικό VBA στο Excel.

1. Στο φύλλο εργασίας περιέχει το γράφημα που θέλετε να επισυνάψετε στο σώμα email, πατήστε το άλλος + F11 για να ανοίξετε το Microsoft Visual Basic για εφαρμογές παράθυρο.

2. Στο Microsoft Visual Basic για εφαρμογές παρακαλώ κάντε κλικ Κύριο θέμα > Μονάδα μέτρησης. Στη συνέχεια, αντιγράψτε κάτω από τον κώδικα VBA στο παράθυρο Code.

Κωδικός VBA: Στείλτε ένα συγκεκριμένο γράφημα σε ένα email στο 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: Στον κωδικό, αλλάξτε τη διεύθυνση email του παραλήπτη και το θέμα του email στη σειρά .Το = "xrr@163.com" και η γραμμή .Θέμα = "Προσθήκη γραφήματος στο σώμα αλληλογραφίας outlook" , Sheet1 είναι το φύλλο που περιέχει το γράφημα που θέλετε να στείλετε, αλλάξτε το στο δικό σας.

3. Πάτα το F5 κλειδί για την εκτέλεση του κώδικα. Στο άνοιγμα Kutools για Excel πλαίσιο διαλόγου, εισαγάγετε το όνομα του γραφήματος που θα επισυνάψετε στο σώμα του email και, στη συνέχεια, κάντε κλικ στο OK κουμπί. Δείτε το στιγμιότυπο οθόνης:

Στη συνέχεια, δημιουργείται αυτόματα ένα μήνυμα ηλεκτρονικού ταχυδρομείου με το καθορισμένο γράφημα να εμφανίζεται στο σώμα του email όπως φαίνεται στο παρακάτω στιγμιότυπο οθόνης. Κάντε κλικ στο κουμπί Αποστολή για να στείλετε αυτό το email.


Σχετικά άρθρα:

 

 

 


Τα καλύτερα εργαλεία παραγωγικότητας του Office

Το Kutools για Excel λύνει τα περισσότερα από τα προβλήματά σας και αυξάνει την παραγωγικότητά σας κατά 80%

  • Επαναχρησιμοποίηση: Εισαγάγετε γρήγορα σύνθετοι τύποι, γραφήματα και οτιδήποτε έχετε χρησιμοποιήσει στο παρελθόν. Κρυπτογράφηση κυττάρων με κωδικό πρόσβασης Δημιουργία λίστας αλληλογραφίας και στείλτε email ...
  • Super Formula Bar (επεξεργαστείτε εύκολα πολλές γραμμές κειμένου και τύπου). Διάταξη ανάγνωσης (εύκολη ανάγνωση και επεξεργασία μεγάλου αριθμού κελιών). Επικόλληση σε φιλτραρισμένο εύρος...
  • Συγχώνευση κελιών / σειρών / στηλών χωρίς απώλεια δεδομένων · Περιεχόμενο διαχωρισμού κελιών Συνδυάστε διπλές σειρές / στήλες... Αποτροπή διπλών κυττάρων; Συγκρίνετε τα εύρη...
  • Επιλέξτε Διπλότυπο ή Μοναδικό Σειρές; Επιλέξτε Κενές σειρές (όλα τα κελιά είναι κενά). Σούπερ εύρεση και ασαφής εύρεση σε πολλά βιβλία εργασίας. Τυχαία επιλογή ...
  • Ακριβές αντίγραφο Πολλαπλά κελιά χωρίς αλλαγή της αναφοράς τύπου. Αυτόματη δημιουργία αναφορών σε πολλαπλά φύλλα? Εισαγωγή κουκκίδων, Πλαίσια ελέγχου και άλλα ...
  • Εξαγωγή κειμένου, Προσθήκη κειμένου, Κατάργηση κατά θέση, Αφαιρέστε το διάστημα; Δημιουργία και εκτύπωση υποσύνολων σελιδοποίησης. Μετατροπή περιεχομένου και σχολίων μεταξύ κελιών...
  • Σούπερ φίλτρο (αποθηκεύστε και εφαρμόστε σχήματα φίλτρων σε άλλα φύλλα). Προηγμένη ταξινόμηση ανά μήνα / εβδομάδα / ημέρα, συχνότητα και άλλα. Ειδικό φίλτρο με έντονη, πλάγια ...
  • Συνδυάστε βιβλία εργασίας και φύλλα εργασίας; Συγχώνευση πινάκων βάσει βασικών στηλών. Διαχωρίστε τα δεδομένα σε πολλά φύλλα; Μαζική μετατροπή xls, xlsx και PDF...
  • Περισσότερα από 300 ισχυρά χαρακτηριστικά. Υποστηρίζει Office / Excel 2007-2021 και 365. Υποστηρίζει όλες τις γλώσσες. Εύκολη ανάπτυξη στην επιχείρηση ή τον οργανισμό σας. Πλήρεις δυνατότητες δωρεάν δοκιμής 30 ημερών. Εγγύηση επιστροφής χρημάτων 60 ημερών.
kte καρτέλα 201905

Το Office Tab φέρνει τη διεπαφή με καρτέλες στο Office και κάνει την εργασία σας πολύ πιο εύκολη

  • Ενεργοποίηση επεξεργασίας και ανάγνωσης καρτελών σε Word, Excel, PowerPoint, Publisher, Access, Visio και Project.
  • Ανοίξτε και δημιουργήστε πολλά έγγραφα σε νέες καρτέλες του ίδιου παραθύρου και όχι σε νέα παράθυρα.
  • Αυξάνει την παραγωγικότητά σας κατά 50% και μειώνει εκατοντάδες κλικ του ποντικιού για εσάς κάθε μέρα!
κάτω μέρος γραφείου

 

 

Σχόλια (13)
Δεν υπάρχουν ακόμη βαθμολογίες. Γίνε ο πρώτος που θα αξιολογήσετε!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
όταν εισάγω το όνομα του γραφήματος, η αλληλογραφία δεν δημιουργεί το παράθυρο διαλόγου απλώς κλείνει, έχετε ιδέα τι έχω κάνει λάθος; Έχω ακολουθήσει κάθε βήμα
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Το ζήτημα είναι ότι δεν μπορούμε να ορίσουμε ονόματα για αντικείμενα γραφήματος όπως πίνακες. Πρέπει να περάσετε το ακέραιο αναγνωριστικό για να λειτουργήσει. Για παράδειγμα, εάν έχετε μόνο 1 γράφημα στο "Φύλλο1", προσπαθώντας να μεταβιβάσετε την τιμή 1 όταν εμφανιστεί το πλαίσιο μηνύματος.

ΥΓ: συγγνώμη για τα άσχημα αγγλικά:]
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
hola como puede enviar por correo, una tabla dinámica, y no un gráfico
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Υπάρχει σφάλμα στον κωδικό: "\") + 1) & "" "" πλάτος=700 ύψος=50Στο κείμενο με έντονη γραφή το μεσαίο θα πρέπει να είναι ένα μόνο ανεστραμμένο κόμμα

Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Περιλαμβάνει το γράφημα ως συνημμένο. Έχετε ιδέα πώς να το συμπεριλάβετε ως εικόνα στο ίδιο το σώμα της αλληλογραφίας; Ευχαριστώ, Youssef
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Το ίδιο πρόβλημα, κάποια λύση;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια J,
Ο κωδικός έχει ενημερωθεί. Δοκιμάστε το. Συγγνώμη για την ταλαιπωρία.


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
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας,
mi nic sie nie załącza, czy coś tutaj należałoby wpisać jeszcze?
xPath = "co tutaj trzeba wprowadzić?"
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου Kuba,
Παρακαλώ αφαιρέστε το / ετικέτα μέσα <img src="/.
Το σφάλμα προκαλείται από τον επεξεργαστή στον ιστότοπο.
Λυπούμαστε για την ταλαιπωρία.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
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 Ήταν 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 ως συμβολοσειρά
Μείωση xChartPath ως συμβολοσειρά
Dim xPath ως συμβολοσειρά
Μείωση xChart ως ChartObject
On Error Συνέχιση Επόμενη
Dim wydzialy As String
wydzialy = λίστα.Κελιά(3, 75)
xChartName = Application.InputBox(wydzialy, "KuTools for Excel", , , , , , 2) 'Wykres1 '"Πληκτρολογήστε το όνομα του γραφήματος:"
Εάν xChartName = "" Τότε βγείτε από το Sub
Ορίστε xChart = Sheets("Wykresy").ChartObjects(xChartName) 'Αλλαγή "Sheet1" στο όνομα του φύλλου εργασίας σας
Εάν το xChart δεν είναι τίποτα, τότε βγείτε από το 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


Dim OutApp ως αντικείμενο
Dim OutMail ως αντικείμενο
Ορισμός OutApp = CreateObject ("Outlook.Application")
Ορισμός OutMail = OutApp.CreateItem(0)
Με OutMail
.Προς = μηνύματα ηλεκτρονικού ταχυδρομείου(β)
.CC = emails_dw(β)
.Subject = "XXXX" ' - " & list.Cells(i, 66)
.Συνημμένα.Προσθήκη xChartPath
.HTMLBody = "treść" & xPath

Ορισμός .SendUsingAccount = OutApp.Session.Accounts.Item(1)

.Απεικόνιση
Τέλος με
Σκοτώστε το xChartPath
Ορισμός OutMail = Τίποτα
Ρύθμιση OutApp = Τίποτα
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου Kuba,
Ο κωδικός έχει ενημερωθεί. Ο παραλήπτης μπορεί να δει το γράφημα κανονικά. Δοκιμάστε το.
Note: Στον κωδικό, αλλάξτε το "Διάγραμμα 1" στο δικό σας όνομα γραφήματος. Και καθορίστε τη διεύθυνση email στο πεδίο Προς.
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
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας, θέλω να προσθέσω χώρο στο σώμα της αλληλογραφίας, ποια λέξη-κλειδί πρέπει να χρησιμοποιήσω.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου pavan chougule,
Οι ακόλουθες δύο γραμμές στον κώδικα περιέχουν το περιεχόμενο του σώματος του email. Μπορείτε να τροποποιήσετε μη αυτόματα το σώμα του email πατώντας το πλήκτρο διαστήματος στο πληκτρολόγιό σας για να προσθέσετε ένα κενό διάστημα.
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>"
Δεν υπάρχουν σχόλια δημοσιεύτηκε ακόμα
Αφήστε τα σχόλιά σας
Δημοσίευση ως επισκέπτης
×
Αξιολογήστε αυτήν την ανάρτηση:
0   Χαρακτήρες
Προτεινόμενες τοποθεσίες

Ακολουθησε μας

Πνευματικά δικαιώματα © 2009 - www.extendoffice.com. | Ολα τα δικαιώματα διατηρούνται. Τροφοδοτείται από ExtendOffice. | Sitemap
Το Microsoft και το λογότυπο του Office είναι εμπορικά σήματα ή σήματα κατατεθέντα της Microsoft Corporation στις Ηνωμένες Πολιτείες ή / και σε άλλες χώρες.
Προστατεύεται από το Sectigo SSL