Excel में संदेश के मुख्य भाग में छवि के रूप में कक्षों की श्रेणी को कैसे चिपकाएँ?
यदि आपको Excel से ईमेल भेजते समय कक्षों की एक श्रृंखला की प्रतिलिपि बनाने और उसे संदेश के मुख्य भाग में एक छवि के रूप में चिपकाने की आवश्यकता है। आप इस कार्य से कैसे निपट सकते हैं?
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 बटन, और ए मैसेज विंडो प्रदर्शित होती है, चयनित डेटा रेंज को छवि के रूप में मुख्य भाग में डाला गया है, स्क्रीनशॉट देखें:
नोट: में मैसेज विंडो, आप आवश्यकतानुसार To और Cc फ़ील्ड में मुख्य सामग्री और ईमेल पते भी बदल सकते हैं।
5. अंत में क्लिक करें भेजें इस ईमेल को भेजने के लिए बटन.
नोट: यदि आपको विभिन्न कार्यपत्रकों से एकाधिक श्रेणियाँ चिपकाने की आवश्यकता है, तो नीचे दिया गया 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
सर्वोत्तम कार्यालय उत्पादकता उपकरण
एक्सेल के लिए कुटूल के साथ अपने एक्सेल कौशल को सुपरचार्ज करें, और पहले जैसी दक्षता का अनुभव करें। एक्सेल के लिए कुटूल उत्पादकता बढ़ाने और समय बचाने के लिए 300 से अधिक उन्नत सुविधाएँ प्रदान करता है। वह सुविधा प्राप्त करने के लिए यहां क्लिक करें जिसकी आपको सबसे अधिक आवश्यकता है...
ऑफिस टैब ऑफिस में टैब्ड इंटरफ़ेस लाता है, और आपके काम को बहुत आसान बनाता है
- Word, Excel, PowerPoint में टैब्ड संपादन और रीडिंग सक्षम करें, प्रकाशक, एक्सेस, विसियो और प्रोजेक्ट।
- नई विंडो के बजाय एक ही विंडो के नए टैब में एकाधिक दस्तावेज़ खोलें और बनाएं।
- आपकी उत्पादकता 50% बढ़ जाती है, और आपके लिए हर दिन सैकड़ों माउस क्लिक कम हो जाते हैं!