วิธีการวางช่วงของเซลล์ลงในเนื้อหาข้อความเป็นรูปภาพใน Excel
หากคุณต้องการคัดลอกช่วงของเซลล์และวางเป็นรูปภาพลงในเนื้อหาข้อความเมื่อคุณส่งอีเมลจาก Excel คุณจะจัดการกับงานนี้ได้อย่างไร?
วางช่วงของเซลล์ลงในเนื้อหาอีเมลเป็นรูปภาพพร้อมรหัส VBA ใน Excel
วางช่วงของเซลล์ลงในเนื้อหาอีเมลเป็นรูปภาพพร้อมรหัส VBA ใน Excel
อาจไม่มีวิธีการอื่นที่ดีสำหรับคุณในการแก้ปัญหานี้รหัส VBA ในบทความนี้สามารถช่วยคุณได้ กรุณาทำตามนี้:
1. เปิดใช้งานแผ่นงานที่คุณต้องการคัดลอกและวางเซลล์เป็นรูปภาพค้างไว้ที่ไฟล์ ALT + F11 คีย์เพื่อเปิด Microsoft Visual Basic สำหรับแอปพลิเคชัน หน้าต่าง
2. คลิก สิ่งที่ใส่เข้าไป > โมดูลและวางรหัสต่อไปนี้ในไฟล์ โมดูล หน้าต่าง.
รหัส VBA: วางช่วงของเซลล์ลงในเนื้อหาอีเมลดังภาพ:
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 และปุ่ม ระบุความประสงค์หรือขอข้อมูลเพิ่มเติม หน้าต่างจะปรากฏขึ้น ช่วงข้อมูลที่เลือกถูกแทรกลงในเนื้อหาเป็นรูปภาพแล้ว ดูภาพหน้าจอ:
หมายเหตุ: ใน ระบุความประสงค์หรือขอข้อมูลเพิ่มเติม หน้าต่าง คุณยังสามารถเปลี่ยนเนื้อหาเนื้อหาและที่อยู่อีเมลในช่องถึงและสำเนาได้ตามที่คุณต้องการ
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
สุดยอดเครื่องมือเพิ่มผลผลิตในสำนักงาน
เพิ่มพูนทักษะ Excel ของคุณด้วย Kutools สำหรับ Excel และสัมผัสประสิทธิภาพอย่างที่ไม่เคยมีมาก่อน Kutools สำหรับ Excel เสนอคุณสมบัติขั้นสูงมากกว่า 300 รายการเพื่อเพิ่มประสิทธิภาพและประหยัดเวลา คลิกที่นี่เพื่อรับคุณสมบัติที่คุณต้องการมากที่สุด...
แท็บ Office นำอินเทอร์เฟซแบบแท็บมาที่ Office และทำให้งานของคุณง่ายขึ้นมาก
- เปิดใช้งานการแก้ไขและอ่านแบบแท็บใน Word, Excel, PowerPoint, ผู้จัดพิมพ์, Access, Visio และโครงการ
- เปิดและสร้างเอกสารหลายรายการในแท็บใหม่ของหน้าต่างเดียวกันแทนที่จะเป็นในหน้าต่างใหม่
- เพิ่มประสิทธิภาพการทำงานของคุณ 50% และลดการคลิกเมาส์หลายร้อยครั้งให้คุณทุกวัน!
