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

كيفية لصق مجموعة من الخلايا في نص الرسالة كصورة في Excel؟

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

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


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

قد لا توجد طريقة أخرى جيدة لحل هذه المهمة ، يمكن أن يساعدك رمز VBA في هذه المقالة. يرجى القيام بذلك على النحو التالي:

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

2. انقر إدراج > وحدة، والصق الكود التالي في ملف وحدة نافذة او شباك.

كود فبا: الصق مجموعة من الخلايا في جسم البريد الإلكتروني كصورة:

Sub sendMail()
    Dim TempFilePath As String
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xHTMLBody As String
    Dim xRg As Range
    On Error Resume Next
    Set xRg = Application.InputBox("Please select the data range:", "KuTools for Excel", Selection.Address, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    With Application
        .Calculation = xlManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Set xOutApp = CreateObject("outlook.application")
    Set xOutMail = xOutApp.CreateItem(olMailItem)
    Call createJpg(ActiveSheet.Name, xRg.Address, "DashboardFile")
    TempFilePath = Environ$("temp") & "\"
    xHTMLBody = "<span LANG=EN>" _
            & "<p class=style2><span LANG=EN><font FACE=Calibri SIZE=3>" _
            & "Hello, this is the data range that you want:<br> " _
            & "<br>" _
            & "<img src='//cdn.extendoffice.com/cid:DashboardFile.jpg'>" _
            & "<br>Best Regards!</font></span>"
    With xOutMail
        .Subject = ""
        .HTMLBody = xHTMLBody
      .Attachments.Add TempFilePath & "DashboardFile.jpg", olByValue
        .To = " "
        .Cc = " "
        .Display
    End With
End Sub
Sub createJpg(SheetName As String, xRgAddrss As String, nameFile As String)
    Dim xRgPic As Range
    Dim xShape As Shape
    ThisWorkbook.Activate
    Worksheets(SheetName).Activate
    Set xRgPic = ThisWorkbook.Worksheets(SheetName).Range(xRgAddrss)
    xRgPic.CopyPicture
    With ThisWorkbook.Worksheets(SheetName).ChartObjects.Add(xRgPic.Left, xRgPic.Top, xRgPic.Width, xRgPic.Height)
        .Activate
        For Each xShape In ActiveSheet.Shapes
            xShape.Line.Visible = msoFalse
        Next
        .Chart.Paste
        .Chart.Export Environ$("temp") & "\" & nameFile & ".jpg", "JPG"
    End With
   Worksheets(SheetName).ChartObjects(Worksheets(SheetName).ChartObjects.Count).Delete
Set xRgPic = Nothing
End Sub

ملاحظات: في الكود أعلاه، يمكنك تغيير محتوى الجسم وعنوان البريد الإلكتروني حسب حاجتك.

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

4. ثم اضغط OK زر، و a الرسالة يتم عرض النافذة، وقد تم إدراج نطاق البيانات المحدد في الجسم كصورة، انظر الصورة:

ملاحظات: في ال الرسالة في النافذة، يمكنك أيضًا تغيير محتوى النص وعناوين البريد الإلكتروني في الحقلين "إلى" و"نسخة" حسب حاجتك.

5. أخيرًا ، انقر فوق أرسل زر لإرسال هذا البريد الإلكتروني.


ملاحظات: إذا كنت بحاجة إلى لصق نطاقات متعددة من أوراق عمل مختلفة، فإن كود VBA أدناه يمكن أن يقدم لك معروفًا:

أولاً، يجب عليك تحديد النطاقات المتعددة التي تريد إدراجها في نص البريد الإلكتروني كصور، ثم قم بتطبيق الكود التالي:

رمز VBA: قم بلصق نطاقات متعددة من الخلايا في نص البريد الإلكتروني كصورة:

Sub sendMail()
    Dim TempFilePath As String
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xHTMLBody As String
    Dim xRg As Range
    Dim xSheet As Worksheet
    Dim xAcSheet As Worksheet
    Dim xFileName As String
    Dim xSrc As String
    On Error Resume Next
    TempFilePath = Environ$("temp") & "\RangePic\"
    If Len(VBA.Dir(TempFilePath, vbDirectory)) = False Then
      VBA.MkDir TempFilePath
    End If
    Set xAcSheet = Application.ActiveSheet
    For Each xSheet In Application.Worksheets
        xSheet.Activate
        Set xRg = xSheet.Application.Selection
        If xRg.Cells.Count > 1 Then
            Call createJpg(xSheet.Name, xRg.Address, "DashboardFile" & VBA.Trim(VBA.Str(xSheet.Index)))
        End If
    Next
    xAcSheet.Activate
    With Application
        .Calculation = xlManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Set xOutApp = CreateObject("outlook.application")
    Set xOutMail = xOutApp.CreateItem(olMailItem)
    xSrc = ""
    xFileName = Dir(TempFilePath & "*.*")
    Do While xFileName <> ""
        xSrc = xSrc + VBA.vbCrLf + "<img src='cid:" + xFileName + "'><br>"
        xFileName = Dir
        If xFileName = "" Then Exit Do
    Loop
    xHTMLBody = "<span LANG=EN>" _
                & "<p class=style2><span LANG=EN><font FACE=Calibri SIZE=3>" _
                & "Hello, this is the data range that you want:<br> " _
                & "<br>" _
                & xSrc _
                & "<br>Best Regards!</font></span>"
    With xOutMail
        .Subject = ""
        .HTMLBody = xHTMLBody
        xFileName = Dir(TempFilePath & "*.*")
        Do While xFileName <> ""
            .Attachments.Add TempFilePath & xFileName, olByValue
            xFileName = Dir
        If xFileName = "" Then Exit Do
        Loop
        .To = " "
        .Cc = " "
       .Display
    End With
    If VBA.Dir(TempFilePath & "*.*") <> "" Then
        VBA.Kill TempFilePath & "*.*"
    End If
End Sub
Sub createJpg(SheetName As String, xRgAddrss As String, nameFile As String)
    Dim xRgPic As Range
    ThisWorkbook.Activate
    Worksheets(SheetName).Activate
    Set xRgPic = ThisWorkbook.Worksheets(SheetName).Range(xRgAddrss)
    xRgPic.CopyPicture
    With ThisWorkbook.Worksheets(SheetName).ChartObjects.Add(xRgPic.Left, xRgPic.Top, xRgPic.Width, xRgPic.Height)
        .Activate
        .Chart.Paste
        .Chart.Export Environ$("temp") & "\RangePic\" & nameFile & ".jpg", "JPG"
    End With
    Worksheets(SheetName).ChartObjects(Worksheets(SheetName).ChartObjects.Count).Delete
Set xRgPic = Nothing
End Sub

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

🤖 مساعد 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 (42)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Hello! The posted code above works great although its bringing along the grid lines from the Excel sheet into the email even though I shut off the visible gridlines in the sheet.. Is there a way to exclude these gridlines? Thank you!!
This comment was minimized by the moderator on the site
Thanks it really great helpful. can u pls help me to auto attached the sheet also while sending the mail  
This comment was minimized by the moderator on the site
Hi, Where I should paste my range for correct function this code.I have still the same range.Thanks for help - Damian.PS. This is´ great
This comment was minimized by the moderator on the site
This method is perfect but I'm unable to take email ids from range. Is there any specific reason ?
This comment was minimized by the moderator on the site
Suggestions for including the default email signature?
This comment was minimized by the moderator on the site
Hi, the macro keep pasting the old image and not the new one, bow can i fix it? If i past Manually it works thanks
This comment was minimized by the moderator on the site
Is there a way to change the name of the JPG file from DashboardFile?
This comment was minimized by the moderator on the site
Thank You, it works great :-)
This comment was minimized by the moderator on the site
Hi, I also have the error that the generated file stays in the temp and isn't being overwritten...
This comment was minimized by the moderator on the site
Hello,
First of all thank you for your work, but I have an issue with it. It seems that the Jpg generated named Dashboardfile stays in temp and the macro always use the same jpg in the email.
Maybe i miss something here. Hope you can help me.
Thank you
Gaëtan
There are no comments posted here yet
Load More
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations