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

كيف ترسل مخططًا معينًا في رسالة بريد إلكتروني باستخدام 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 = "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

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

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

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


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

 

 

 


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

Kutools for Excel يحل معظم مشاكلك ويزيد إنتاجيتك بنسبة 80٪

  • إعادة استخدام: أدخل بسرعة الصيغ المعقدة والرسوم البيانية وأي شيء استخدمته من قبل ؛ تشفير الخلايا مع كلمة السر إنشاء قائمة بريدية وإرسال رسائل البريد الإلكتروني ...
  • سوبر فورميولا بار (بسهولة تحرير أسطر متعددة من النص والصيغة) ؛ تخطيط القراءة (قراءة وتحرير أعداد كبيرة من الخلايا بسهولة) ؛ لصق في النطاق المصفى
  • دمج الخلايا / الصفوف / الأعمدة دون فقدان البيانات ؛ تقسيم محتوى الخلايا ؛ ادمج الصفوف / الأعمدة المكررة... منع تكرار الخلايا؛ قارن النطاقات
  • حدد مكرر أو فريد صفوف حدد صفوف فارغة (جميع الخلايا فارغة) ؛ البحث الفائق والبحث الغامض في العديد من المصنفات. تحديد عشوائي ...
  • نسخة طبق الأصل خلايا متعددة بدون تغيير مرجع الصيغة ؛ إنشاء المراجع تلقائيًا إلى أوراق متعددة أدخل الرموز النقطية، مربعات الاختيار والمزيد ...
  • استخراج النص، إضافة نص ، إزالة حسب الموضع ، إزالة الفضاء؛ إنشاء وطباعة المجاميع الفرعية لترحيل الصفحات ؛ التحويل بين محتوى الخلايا والتعليقات
  • سوبر تصفية (حفظ وتطبيق مخططات التصفية على أوراق أخرى) ؛ فرز متقدم حسب الشهر / الأسبوع / اليوم ، التكرار والمزيد ؛ مرشح خاص بواسطة bold، italic ...
  • اجمع بين المصنفات وأوراق العمل؛ دمج الجداول على أساس الأعمدة الرئيسية ؛ تقسيم البيانات إلى أوراق متعددة; تحويل دفعة xls و xlsx و PDF
  • أكثر من 300 ميزة قوية. يدعم Office / Excel 2007-2021 و 365. يدعم جميع اللغات. سهولة النشر في مؤسستك أو مؤسستك. الميزات الكاملة نسخة تجريبية مجانية لمدة 30 يومًا. ضمان استرداد الأموال لمدة 60 يومًا.
علامة تبويب kte 201905

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

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

 

 

فرز التعليقات حسب
التعليقات (13)
لا يوجد تقييم. كن أول من يقيم!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
عندما أقوم بإدخال اسم المخطط ، لا يقوم البريد بإنشاء مربع الحوار يغلق فقط ، فهل لديك فكرة عما فعلته بشكل خاطئ؟ لقد اتبعت كل خطوة
تم تصغير هذا التعليق بواسطة المشرف على الموقع
المشكلة هي أننا لا نستطيع تعيين أسماء لكائنات المخطط مثل الجداول. تحتاج إلى تمرير معرف عدد صحيح للعمل. على سبيل المثال ، إذا كان لديك مخطط واحد فقط في "الورقة 1" ، فحاول تمرير القيمة 1 عند ظهور msgbox.

ملاحظة: آسف للغة الإنجليزية السيئة:]
تم تصغير هذا التعليق بواسطة المشرف على الموقع
hola como puede enviar por correo، una tabla dinámica، y no un un gráfico
تم تصغير هذا التعليق بواسطة المشرف على الموقع
يوجد خطأ في الكود: "\") + 1) & "" " العرض = 700 ارتفاع = 50 في النص الغامق ، يجب أن يكون الوسط الأوسط فاصلة واحدة مقلوبة

تم تصغير هذا التعليق بواسطة المشرف على الموقع
يتضمن الرسم البياني كمرفق. هل لديك أي فكرة عن كيفية تضمينها كصورة في نص البريد نفسه. شكرا يوسف
تم تصغير هذا التعليق بواسطة المشرف على الموقع
نفس المشكلة ، أي حل؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا 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
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا،
my nic sie nie załącza، czy coś tutaj należałoby wpisać jeszcze؟
xPath = "co tutaj trzeba wprowadzić؟"
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا كوبا ،
الرجاء إزالة / العلامة في <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 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 :)

خافت xChartName كسلسلة
خافت xChartPath كسلسلة
خافت xPath كسلسلة
Dim xChart كـ ChartObject
على خطأ استئناف التالي
ديم wydzialy كسلسلة
wydzialy = lista.Cells (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


خافت OutApp ككائن
تعتيم البريد الخارجي ككائن
تعيين OutApp = CreateObject ("Outlook.Application")
تعيين OutMail = OutApp.CreateItem (0)
مع OutMail
. إلى = رسائل البريد الإلكتروني (ب)
.CC = emails_dw (ب)
.Subject = "XXXX" '- "& lista.Cells (i، 66)
المرفقات. إضافة xChartPath
.HTMLBody = "treść" & xPath

تعيين .SendUsingAccount = OutApp.Session.Accounts.Item (1)

.عرض
انتهت ب
اقتل xChartPath
تعيين OutMail = لا شيء
تعيين OutApp = لا شيء
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا كوبا ،
تم تحديث الرمز. يمكن للمستلم عرض الرسم البياني بشكل طبيعي. يرجى محاولة إعطائها.
ملاحظة: في الكود ، يرجى تغيير "الرسم البياني 2"إلى اسم المخطط الخاص بك. وتحديد عنوان البريد الإلكتروني في الحقل" إلى ".
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 ،
يحتوي السطران التاليان في الكود على محتوى نص البريد الإلكتروني. يمكنك تعديل نص البريد الإلكتروني يدويًا بالضغط على مفتاح المسافة على لوحة المفاتيح لإضافة مسافة.
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 - شبكة الاتصالات العالمية.extendoffice.com. | كل الحقوق محفوظة. مشغل بواسطة ExtendOffice. | | خريطة الموقع
Microsoft وشعار Office هما علامتان تجاريتان أو علامتان تجاريتان مسجلتان لشركة Microsoft Corporation في الولايات المتحدة و / أو دول أخرى.
محمي بواسطة Sectigo SSL