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

Làm cách nào để gửi một biểu đồ cụ thể trong email bằng vba trong Excel?

Bạn có thể biết cách gửi email qua Outlook trong Excel với mã VBA. Tuy nhiên, bạn có biết cách đính kèm một biểu đồ cụ thể trong một trang tính nhất định vào phần nội dung của email không? Bài viết này sẽ chỉ cho bạn phương pháp để giải quyết vấn đề này.

Gửi một biểu đồ cụ thể trong email trong Excel với mã VBA


Gửi một biểu đồ cụ thể trong email trong Excel với mã VBA

Vui lòng thực hiện như sau để gửi biểu đồ cụ thể trong email có mã VBA trong Excel.

1. Trong trang tính có chứa biểu đồ bạn muốn đính kèm trong nội dung email, hãy nhấn Khác + F11 phím để mở Microsoft Visual Basic cho các ứng dụng cửa sổ.

2. bên trong Microsoft Visual Basic cho các ứng dụng cửa sổ, vui lòng nhấp vào Chèn > Mô-đun. Sau đó sao chép mã VBA bên dưới vào cửa sổ Mã.

Mã VBA: Gửi một biểu đồ cụ thể trong email trong Excel

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

Chú thích: Trong mã, vui lòng thay đổi địa chỉ email của người nhận và chủ đề email trong dòng .To = "xrr@163.com" và dòng .Subject = "Thêm biểu đồ trong nội dung thư outlook" , Sheet1 là trang tính chứa biểu đồ bạn muốn gửi, vui lòng thay đổi nó thành biểu đồ của riêng bạn.

3. Nhấn nút F5 phím để chạy mã. Trong phần mở đầu Kutools cho Excel hộp thoại, nhập tên của biểu đồ bạn sẽ đính kèm trong nội dung email, sau đó bấm vào OK cái nút. Xem ảnh chụp màn hình:

Sau đó, một email được tạo tự động với biểu đồ được chỉ định hiển thị trong nội dung email như ảnh chụp màn hình bên dưới. Vui lòng nhấp vào nút Gửi để gửi email này.


Các bài liên quan:

 

 

 


Các công cụ năng suất văn phòng tốt nhất

Kutools cho Excel giải quyết hầu hết các vấn đề của bạn và tăng 80% năng suất của bạn

  • Tái sử dụng: Chèn nhanh công thức phức tạp, biểu đồ và bất cứ thứ gì bạn đã sử dụng trước đây; Mã hóa ô với mật khẩu; Tạo danh sách gửi thư và gửi email ...
  • Thanh siêu công thức (dễ dàng chỉnh sửa nhiều dòng văn bản và công thức); Bố cục đọc (dễ dàng đọc và chỉnh sửa số lượng ô lớn); Dán vào Dải ô đã Lọchữu ích. Cảm ơn !
  • Hợp nhất các ô / hàng / cột mà không làm mất dữ liệu; Nội dung phân chia ô; Kết hợp các hàng / cột trùng lặp... Ngăn chặn các ô trùng lặp; So sánh các dãyhữu ích. Cảm ơn !
  • Chọn trùng lặp hoặc duy nhất Hàng; Chọn hàng trống (tất cả các ô đều trống); Tìm siêu và Tìm mờ trong Nhiều Sổ làm việc; Chọn ngẫu nhiên ...
  • Bản sao chính xác Nhiều ô mà không thay đổi tham chiếu công thức; Tự động tạo tài liệu tham khảo sang Nhiều Trang tính; Chèn Bullets, Hộp kiểm và hơn thế nữa ...
  • Trích xuất văn bản, Thêm Văn bản, Xóa theo Vị trí, Xóa không gian; Tạo và In Tổng số phân trang; Chuyển đổi giữa nội dung ô và nhận xéthữu ích. Cảm ơn !
  • Siêu lọc (lưu và áp dụng các lược đồ lọc cho các trang tính khác); Sắp xếp nâng cao theo tháng / tuần / ngày, tần suất và hơn thế nữa; Bộ lọc đặc biệt bằng cách in đậm, in nghiêng ...
  • Kết hợp Workbook và WorkSheets; Hợp nhất các bảng dựa trên các cột chính; Chia dữ liệu thành nhiều trang tính; Chuyển đổi hàng loạt xls, xlsx và PDFhữu ích. Cảm ơn !
  • Hơn 300 tính năng mạnh mẽ. Hỗ trợ Office / Excel 2007-2021 và 365. Hỗ trợ tất cả các ngôn ngữ. Dễ dàng triển khai trong doanh nghiệp hoặc tổ chức của bạn. Đầy đủ tính năng Dùng thử miễn phí 30 ngày. Bảo đảm hoàn lại tiền trong 60 ngày.
tab kte 201905

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!
officetab dưới cùng

 

 

Nhận xét (13)
Chưa có xếp hạng. Hãy là người đầu tiên xếp hạng!
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Khi tôi nhập tên biểu đồ, thư không tạo ra hộp thoại chỉ đóng lại, bất kỳ ý tưởng nào tôi đã làm sai? Tôi đã làm theo từng bước
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Vấn đề là chúng ta không thể đặt tên cho các Đối tượng Biểu đồ như bảng. Bạn cần chuyển ID số nguyên để hoạt động. Ví dụ: nếu bạn chỉ có 1 biểu đồ trong "Sheet1", hãy thử chuyển giá trị 1 khi hộp thư tín hiệu hiển thị.

PS: xin lỗi vì tiếng anh kém:]
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
hola como puede enviar bởi Correo, una tabla dinámica, y no un gráfico
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Có lỗi trong mã: "\") + 1) & "" " width = 700 height = 50 Trong văn bản in đậm, văn bản ở giữa phải là một dấu phẩy đảo ngược

Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Nó bao gồm biểu đồ dưới dạng tệp đính kèm. Bạn có bất kỳ ý tưởng nào về cách bao gồm nó như một hình ảnh trong chính nội dung thư. Cảm ơn bạn, Youssef
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Cùng một vấn đề, bất kỳ giải pháp?
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Chào J ,
Mã đã được cập nhật. Hãy thử nó. Xin lỗi vì sự bất tiện.


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
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào,
mi nic sie nie załącza, czy coś tutaj należałoby wpisać jeszcze?
xPath = "co tutaj trzeba wprowadzić?"
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Chào Kuba,
Vui lòng loại bỏ / gắn thẻ vào <img src="/.
Lỗi là do người biên tập trong trang web.
Xin lỗi vì sự bất tiện.
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
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 Có phải bạn đã biết không? Prosze o pomoc, tutaj kod, który dotyczy wykresum już tak mało brakuje :)

Dim xChartName thành chuỗi
Dim xChartPath dưới dạng chuỗi
Dim xPath dưới dạng chuỗi
Làm mờ xChart dưới dạng ChartObject
On Error Resume Next
Dim wydzialy như chuỗi
wydzialy = lista.Cells (3, 75)
xChartName = Application.InputBox (wydzialy, "KuTools cho Excel",,,,, 2) 'Wykres1' "Vui lòng nhập tên biểu đồ:"
If xChartName = "" Then Exit Sub
Đặt xChart = Sheets ("Wykresy"). ChartObjects (xChartName) 'Thay đổi "Sheet1" thành tên trang tính của bạn
Nếu xChart không có gì thì thoát Sub
xChartPath = Application.ActiveWorkbook.Path & "\" & Environ ("USERNAME") & VBA.Format (VBA.Now (), "DD_MM_YY_HH_MM_SS") & ".svg" '.bmp' .svg '.svg ma lepsza jakość
xĐường dẫn = " "
xChart.Chart.Xuất xChartPath


Làm mờ ứng dụng dưới dạng đối tượng
Dim OutMail làm đối tượng
Đặt OutApp = CreateObject ("Outlook.Application")
Đặt OutMail = OutApp.CreateItem (0)
Với OutMail
.To = email (b)
.CC = email_dw (b)
.Subject = "XXXX" '- "& lista.Cells (i, 66)
.Attachments.Add xChartPath
.HTMLBody = "treść" & xPath

Đặt .SendUsingAccount = OutApp.Session.Accounts.Item (1)

.Trưng bày
Kết thúc với
Giết xChartPath
Set OutMail = Không có gì
Đặt OutApp = Không có gì
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Chào Kuba,
Mã đã được cập nhật. Người nhận có thể xem biểu đồ bình thường. Hãy thử một lần.
Chú thích: Trong mã, vui lòng thay đổi "Biểu đồ 1"thành tên biểu đồ của riêng bạn. Và chỉ định địa chỉ email trong trường Tới.
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
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
HELLO, tôi muốn thêm khoảng trống trong nội dung thư, tôi nên sử dụng từ khóa nào.
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Chào pavan chougule,
Hai dòng sau trong mã chứa nội dung email. Bạn có thể sửa đổi nội dung email theo cách thủ công bằng cách nhấn phím cách trên bàn phím để thêm khoảng trắng.
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>"
Không có bình luận nào được đăng ở đây
Để lại ý kiến ​​của bạn
Đăng với tư cách khách
×
Đánh giá bài viết này:
0   Nhân vật
Các vị trí được đề xuất

Kết nối với chúng tôi

Bản quyền © 2009 - www.extendoffice.com. | Đã đăng ký Bản quyền. cung cấp bởi ExtendOffice. | BẢN ĐỒ CHI NHÁNH
Microsoft và logo Office là các nhãn hiệu hoặc nhãn hiệu đã đăng ký của Microsoft Corporation tại Hoa Kỳ và / hoặc các quốc gia khác.
Được bảo vệ bởi Sectigo SSL