Làm cách nào để dán một dải ô vào nội dung thư dưới dạng hình ảnh trong Excel?
Nếu bạn cần sao chép một dải ô và dán nó dưới dạng hình ảnh vào nội dung thư khi bạn gửi email từ Excel. Làm thế nào bạn có thể đối phó với nhiệm vụ này?
Dán một dải ô vào nội dung email dưới dạng hình ảnh với mã VBA trong Excel
Dán một dải ô vào nội dung email dưới dạng hình ảnh với mã VBA trong Excel
Có thể không có phương pháp tốt nào khác để bạn giải quyết công việc này, một đoạn mã VBA trong bài viết này có thể giúp bạn. Vui lòng làm như sau:
1. Bật trang tính bạn muốn sao chép và dán các ô dưới dạng hình ảnh, nhấn và giữ ALT + F11 phím để mở Microsoft Visual Basic cho các ứng dụng cửa sổ.
2. Nhấp chuột Chèn > Mô-đunvà dán mã sau vào Mô-đun Cửa sổ.
Mã VBA: dán một dải ô vào nội dung email dưới dạng hình ảnh:
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
Chú thích: Trong đoạn mã trên, bạn có thể thay đổi nội dung cơ thể và địa chỉ email theo nhu cầu của mình.
3. Sau khi chèn mã, nhấn F5 để chạy mã này, một hộp thoại hiện ra để nhắc bạn chọn phạm vi dữ liệu mà bạn muốn chèn vào nội dung email như hình ảnh, xem ảnh chụp màn hình:
4. Sau đó nhấn vào OK và một Tin nhắn cửa sổ được hiển thị, phạm vi dữ liệu đã chọn đã được chèn vào nội dung dưới dạng hình ảnh, xem ảnh chụp màn hình:
Chú thích: Bên trong Tin nhắn , bạn cũng có thể thay đổi nội dung nội dung và địa chỉ Email trong các trường Tới và Cc khi bạn cần.
5. Cuối cùng, hãy nhấp vào Gửi để gửi email này.
Chú thích: Nếu bạn cần dán nhiều phạm vi từ các trang tính khác nhau, mã VBA dưới đây có thể giúp bạn:
Trước tiên, bạn nên chọn nhiều phạm vi mà bạn muốn chèn vào nội dung email dưới dạng hình ảnh, sau đó áp dụng mã sau:
Mã VBA: dán nhiều dải ô vào nội dung email dưới dạng hình ảnh:
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
Công cụ năng suất văn phòng tốt nhất
Nâng cao kỹ năng Excel của bạn với Kutools for Excel và trải nghiệm hiệu quả hơn bao giờ hết. Kutools for Excel cung cấp hơn 300 tính năng nâng cao để tăng năng suất và tiết kiệm thời gian. Bấm vào đây để có được tính năng bạn cần nhất...
Tab Office mang lại giao diện Tab cho Office và giúp công việc của bạn trở nên dễ dàng hơn nhiều
- Cho phép chỉnh sửa và đọc theo thẻ trong Word, Excel, PowerPoint, Publisher, Access, Visio và Project.
- Mở và tạo nhiều tài liệu trong các tab mới của cùng một cửa sổ, thay vì trong các cửa sổ mới.
- Tăng 50% năng suất của bạn và giảm hàng trăm cú nhấp chuột cho bạn mỗi ngày!
