انتقل إلى المحتوى الرئيسي

كيف ترسل مخططًا معينًا في رسالة بريد إلكتروني باستخدام vba في Excel؟

قد تعرف كيفية إرسال بريد إلكتروني من خلال Outlook في Excel باستخدام كود VBA. ومع ذلك ، هل تعرف كيفية إرفاق مخطط معين في ورقة عمل معينة في نص البريد الإلكتروني؟ ستوضح لك هذه المقالة طريقة حل هذه المشكلة.

أرسل مخططًا محددًا في رسالة بريد إلكتروني في Excel مع كود VBA


أرسل مخططًا محددًا في رسالة بريد إلكتروني في Excel مع كود VBA

يرجى القيام بما يلي لإرسال مخطط محدد في رسالة بريد إلكتروني مع رمز VBA في Excel.

1. في ورقة العمل التي تحتوي على الرسم البياني الذي تريد إرفاقه في نص البريد الإلكتروني ، اضغط على قديم + F11 مفاتيح لفتح ميكروسوفت فيسوال باسيك للتطبيقات نافذة.

2. في ال ميكروسوفت فيسوال باسيك للتطبيقات نافذة ، الرجاء الضغط إدراج > وحدة. ثم انسخ رمز VBA أدناه في نافذة التعليمات البرمجية.

كود فبا: أرسل مخططًا محددًا في بريد إلكتروني في إكسيل

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 = ""
        .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

ملاحظات: في الرمز ، يرجى تغيير عنوان البريد الإلكتروني للمستلم وموضوع البريد الإلكتروني في السطر . إلى = "" وخط .Subject = "إضافة مخطط في نص بريد Outlook" , Sheet1 هي الورقة التي تحتوي على الرسم البياني الذي تريد إرساله ، يرجى تغييره إلى الجدول الخاص بك.

3. اضغط على F5 مفتاح لتشغيل الكود. في الافتتاح كوتولس ل إكسيل في مربع الحوار ، أدخل اسم المخطط الذي سترفقه في نص البريد الإلكتروني ، ثم انقر فوق OK زر. انظر لقطة الشاشة:

ثم يتم إنشاء بريد إلكتروني تلقائيًا مع عرض الرسم البياني المحدد في نص البريد الإلكتروني كما هو موضح أدناه. الرجاء النقر فوق الزر إرسال لإرسال هذا البريد الإلكتروني.


مقالات ذات صلة:

 

 

 

أفضل أدوات إنتاجية المكتب

🤖 مساعد Kutools AI: إحداث ثورة في تحليل البيانات على أساس: التنفيذ الذكي   |  إنشاء التعليمات البرمجية  |  إنشاء صيغ مخصصة  |  تحليل البيانات وإنشاء الرسوم البيانية  |  استدعاء وظائف Kutools...
الميزات الشعبية: البحث عن التكرارات أو تمييزها أو تحديدها   |  حذف الصفوف الفارغة   |  دمج الأعمدة أو الخلايا دون فقدان البيانات   |   جولة بدون صيغة 
سوبر بحث: معايير متعددة VLookup    VLookup ذات القيمة المتعددة  |   VLookup عبر أوراق متعددة   |   بحث غامض ....
قائمة منسدلة متقدمة: إنشاء القائمة المنسدلة بسرعة   |  القائمة المنسدلة التابعة   |  قائمة منسدلة متعددة التحديد ....
مدير العمود: إضافة عدد محدد من الأعمدة  |  نقل الأعمدة  |  تبديل حالة رؤية الأعمدة المخفية  |  مقارنة النطاقات والأعمدة 
الميزات المميزة: التركيز على الشبكة   |  عرض تصميم   |   شريط الفورمولا الكبير    مدير المصنفات والأوراق   |  مكتبة الموارد (النص السيارات)   |  منتقي التاريخ   |  اجمع أوراق العمل   |  تشفير/فك تشفير الخلايا    إرسال رسائل البريد الإلكتروني عن طريق القائمة   |  سوبر تصفية   |   مرشح خاص (تصفية غامق / مائل / يتوسطه خط ...) ...
أفضل 15 مجموعة أدوات12 نص الأدوات (إضافة نص, إزالة الأحرف، ...)   |   +50 رسم الأنواع (مخطط جانت، ...)   |   40+ عملي الصيغ (احسب العمر على أساس تاريخ الميلاد، ...)   |   19 إدخال الأدوات (أدخل رمز الاستجابة السريعة, إدراج صورة من المسار، ...)   |   12 تحويل الأدوات (أرقام إلى كلمات, نتيجة تحويل عملة، ...)   |   7 دمج وتقسيم الأدوات (الجمع بين الصفوف المتقدمة, تقسيم الخلايا، ...)   |   ... و اكثر

عزز مهاراتك في Excel باستخدام Kutools for Excel، واختبر كفاءة لم يسبق لها مثيل. يقدم Kutools for Excel أكثر من 300 ميزة متقدمة لتعزيز الإنتاجية وتوفير الوقت.  انقر هنا للحصول على الميزة التي تحتاجها أكثر...

الوصف


يجلب Office Tab الواجهة المبوبة إلى Office ، ويجعل عملك أسهل بكثير

  • تمكين التحرير والقراءة المبوبة في Word و Excel و PowerPointوالناشر والوصول و Visio والمشروع.
  • فتح وإنشاء مستندات متعددة في علامات تبويب جديدة من نفس النافذة ، بدلاً من النوافذ الجديدة.
  • يزيد من إنتاجيتك بنسبة 50٪ ، ويقلل مئات النقرات بالماوس كل يوم!

 

 

Comments (15)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
With the above code, Chart can be seen in the Email body with the .Display.

When .Send is used to send the message, Mail dosent show chart in the Email body.
This comment was minimized by the moderator on the site
Hi Jyoti,

Can you tell me what version of Excel you are using? The code works fine whether I change .Display to .Send or not.
This comment was minimized by the moderator on the site
HELLO , I want to add space in mail body , which keyword should I use.
This comment was minimized by the moderator on the site
Hi pavan chougule,
The following two lines in the code contain the email body content. You can manually modify the email body by pressing the space key on your keyboard to add a space.
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>"
This comment was minimized by the moderator on the site
It includes the chart as an attachment. Do you have any idea how to include it as a picture in the mail body itself. Thank you,Youssef
This comment was minimized by the moderator on the site
Same problem, any solution?
This comment was minimized by the moderator on the site
Hi J,
The code has been updated. Please give it a try. Sorry for the inconvenience.


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 = ""
        .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
This comment was minimized by the moderator on the site
Cześć,
mi nic sie nie załącza, czy coś tutaj należałoby wpisać jeszcze?
xPath = "co tutaj trzeba wprowadzić?"
This comment was minimized by the moderator on the site
Hi Kuba,
The code has been updated. The recipient can view the chart normally. Please give it a try.
Note: In the code, please change the "Chart 1" to your own chart name. And specify the email address in the To field.
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
This comment was minimized by the moderator on the site
Hi Kuba,
Please remove the / tag in <img src="/.
The error is caused by the editor in the site.
Sorry for the inconvenience.
This comment was minimized by the moderator on the site
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 As String
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 '"Please enter the chart name:"
If xChartName = "" Then Exit Sub
Set xChart = Sheets("Wykresy").ChartObjects(xChartName) 'Change "Sheet1" to your worksheet name
If xChart Is Nothing Then 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 = "<p align='Left'><img src="/%20&%20"cid:" & Mid(xChartPath, InStrRev(xChartPath, "\") + 1) & """ width=500 height=300 > <br> <br>"
xChart.Chart.Export xChartPath


Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = emails(b)
.CC = emails_dw(b)
.Subject = "XXXX" ' - " & lista.Cells(i, 66)
.Attachments.Add xChartPath
.HTMLBody = "treść" & xPath

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

.Display
End With
Kill xChartPath
Set OutMail = Nothing
Set OutApp = Nothing
This comment was minimized by the moderator on the site
There is error in the code : "\") + 1) & """ width=700 height=50In the bold text the middle one should be a single inverted comma

This comment was minimized by the moderator on the site
hola como puede enviar por correo, una tabla dinámica, y no un gráfico
This comment was minimized by the moderator on the site
when i enter the chart name the mail doesn't generate the dialog box just closes, any idea what i have done wrong? I have followed each step
This comment was minimized by the moderator on the site
The issue is that we can not set names for Chart Objects like tables. You need to pass the integer ID to work. For instance, if you only have 1 chart in the "Sheet1", trying passing the value 1 when the msgbox shows up.

PS: sorry for the bad english :]
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations