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

วิธีส่งแผนภูมิเฉพาะในอีเมลด้วย vba ใน Excel

คุณอาจทราบวิธีส่งอีเมลผ่าน Outlook ใน Excel ด้วยรหัส VBA อย่างไรก็ตามคุณรู้วิธีแนบแผนภูมิเฉพาะในแผ่นงานบางแผ่นลงในเนื้อหาของอีเมลหรือไม่? บทความนี้จะแสดงวิธีการแก้ปัญหานี้

ส่งแผนภูมิเฉพาะในอีเมลใน Excel พร้อมรหัส VBA


ส่งแผนภูมิเฉพาะในอีเมลใน Excel พร้อมรหัส VBA

โปรดทำดังนี้เพื่อส่งแผนภูมิเฉพาะในอีเมลพร้อมรหัส VBA ใน Excel

1. ในแผ่นงานมีแผนภูมิที่คุณต้องการแนบในเนื้อหาอีเมลให้กดปุ่ม อื่น ๆ + F11 คีย์เพื่อเปิด Microsoft Visual Basic สำหรับแอปพลิเคชัน หน้าต่าง

2 ใน Microsoft Visual Basic สำหรับแอปพลิเคชัน โปรดคลิก สิ่งที่ใส่เข้าไป > โมดูล. จากนั้นคัดลอกโค้ด VBA ด้านล่างลงในหน้าต่างรหัส

รหัส VBA: ส่งแผนภูมิเฉพาะในอีเมลใน 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

หมายเหตุ: ในรหัสโปรดเปลี่ยนที่อยู่อีเมลของผู้รับและหัวเรื่องอีเมลในบรรทัด . ถึง = "xrr@163.com" เส้นและ .Subject = "เพิ่มแผนภูมิในเนื้อหาจดหมายของ Outlook" , Sheet1 คือแผ่นงานที่มีแผนภูมิที่คุณต้องการส่งโปรดเปลี่ยนเป็นของคุณเอง

3 กด F5 กุญแจสำคัญในการเรียกใช้รหัส ในการเปิด Kutools สำหรับ Excel กล่องโต้ตอบป้อนชื่อของแผนภูมิที่คุณจะแนบในเนื้อหาอีเมลจากนั้นคลิกที่ไฟล์ OK ปุ่ม. ดูภาพหน้าจอ:

จากนั้นอีเมลจะถูกสร้างขึ้นโดยอัตโนมัติพร้อมกับแผนภูมิที่ระบุซึ่งแสดงในเนื้อหาอีเมลดังภาพด้านล่างที่แสดง กรุณาคลิกปุ่มส่งเพื่อส่งอีเมลนี้


บทความที่เกี่ยวข้อง:

 

 

 


เครื่องมือเพิ่มประสิทธิภาพการทำงานในสำนักงานที่ดีที่สุด

Kutools สำหรับ Excel แก้ปัญหาส่วนใหญ่ของคุณและเพิ่มผลผลิตของคุณได้ถึง 80%

  • นำมาใช้ใหม่: ใส่อย่างรวดเร็ว สูตรที่ซับซ้อนแผนภูมิ และสิ่งที่คุณเคยใช้มาก่อน เข้ารหัสเซลล์ ด้วยรหัสผ่าน; สร้างรายชื่อผู้รับจดหมาย และส่งอีเมล ...
  • ซุปเปอร์ฟอร์มูล่าบาร์ (แก้ไขข้อความและสูตรหลายบรรทัดได้อย่างง่ายดาย); การอ่านเค้าโครง (อ่านและแก้ไขเซลล์จำนวนมากได้อย่างง่ายดาย); วางลงในช่วงที่กรองแล้ว...
  • ผสานเซลล์ / แถว / คอลัมน์ โดยไม่สูญเสียข้อมูล แยกเนื้อหาของเซลล์ รวมแถว / คอลัมน์ที่ซ้ำกัน... ป้องกันเซลล์ซ้ำ; เปรียบเทียบช่วง...
  • เลือกซ้ำหรือไม่ซ้ำ แถว; เลือกแถวว่าง (เซลล์ทั้งหมดว่างเปล่า); Super Find และ Fuzzy Find ในสมุดงานจำนวนมาก สุ่มเลือก ...
  • สำเนาถูกต้อง หลายเซลล์โดยไม่เปลี่ยนการอ้างอิงสูตร สร้างการอ้างอิงอัตโนมัติ ถึงหลายแผ่น ใส่สัญลักษณ์แสดงหัวข้อย่อย, กล่องกาเครื่องหมายและอื่น ๆ ...
  • แยกข้อความ, เพิ่มข้อความ, ลบตามตำแหน่ง, ลบ Space; สร้างและพิมพ์ผลรวมย่อยของเพจ แปลงระหว่างเนื้อหาของเซลล์และความคิดเห็น...
  • ซุปเปอร์ฟิลเตอร์ (บันทึกและใช้โครงร่างตัวกรองกับแผ่นงานอื่น ๆ ); การเรียงลำดับขั้นสูง ตามเดือน / สัปดาห์ / วันความถี่และอื่น ๆ ตัวกรองพิเศษ โดยตัวหนาตัวเอียง ...
  • รวมสมุดงานและแผ่นงาน; ผสานตารางตามคอลัมน์สำคัญ แยกข้อมูลออกเป็นหลายแผ่น; Batch แปลง xls, xlsx และ PDF...
  • คุณสมบัติที่ทรงพลังมากกว่า 300 รายการ. รองรับ Office/Excel 2007-2021 และ 365 รองรับทุกภาษา ง่ายต่อการปรับใช้ในองค์กรหรือองค์กรของคุณ คุณสมบัติเต็มรูปแบบ ทดลองใช้ฟรี 30 วัน รับประกันคืนเงินภายใน 60 วัน
kte แท็บ 201905

แท็บ Office นำอินเทอร์เฟซแบบแท็บมาที่ Office และทำให้งานของคุณง่ายขึ้นมาก

  • เปิดใช้งานการแก้ไขและอ่านแบบแท็บใน Word, Excel, PowerPoint, ผู้จัดพิมพ์, Access, Visio และโครงการ
  • เปิดและสร้างเอกสารหลายรายการในแท็บใหม่ของหน้าต่างเดียวกันแทนที่จะเป็นในหน้าต่างใหม่
  • เพิ่มประสิทธิภาพการทำงานของคุณ 50% และลดการคลิกเมาส์หลายร้อยครั้งให้คุณทุกวัน!
ด้านล่าง officetab

 

 

จัดเรียงความคิดเห็นโดย
ความคิดเห็น (13)
ยังไม่มีการให้คะแนน เป็นคนแรกที่ให้คะแนน!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
เมื่อฉันป้อนชื่อแผนภูมิ เมลไม่สร้างกล่องโต้ตอบเพียงแค่ปิด ทราบหรือไม่ว่าฉันทำอะไรผิด ฉันได้ทำตามแต่ละขั้นตอน
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ปัญหาคือเราไม่สามารถตั้งชื่อสำหรับ Chart Objects เช่นตารางได้ คุณต้องส่ง ID จำนวนเต็มจึงจะใช้งานได้ ตัวอย่างเช่น หากคุณมี 1 แผนภูมิใน "Sheet1" ให้ลองส่งค่า 1 เมื่อ msgbox ปรากฏขึ้น

PS: ขอโทษสำหรับภาษาอังกฤษที่ไม่ดี:]
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
hola como puede enviar por correo, una tabla dinámica, y no un กราฟฟิค
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
มีข้อผิดพลาดในรหัส: "\") + 1) & "" " width=700 height=50ในข้อความตัวหนา ตัวกลางควรเป็นเครื่องหมายจุลภาคกลับด้านเดียว

ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
รวมถึงแผนภูมิเป็นไฟล์แนบ คุณมีความคิดอย่างไรที่จะรวมมันเป็นรูปภาพในเนื้อหาของเมล ขอบคุณค่ะคุณยูเซฟ
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ปัญหาเดียวกัน มีวิธีแก้ไขไหม?
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี เจ
รหัสได้รับการปรับปรุง กรุณาให้มันลอง ขออภัยในความไม่สะดวก.


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
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี
mi nic sie nie załącza, czy coś tutaj należałoโดย wpisać jeszcze?
xPath = "ร่วม tutaj trzeba wprowadzić?"
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีคูบา
โปรดลบ / แท็กใน <img src="/.
ข้อผิดพลาดเกิดจากตัวแก้ไขในไซต์
ขออภัยในความไม่สะดวก.
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
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 เป็น też tak ktoś miał czy tylko u mnie taki zonk หรือไม่ Prosze o pomoc, tutaj kod, który dotyczy wykresum już tak mało brakuje :)

Dim xChartName เป็นสตริง
Dim xChartPath เป็นสตริง
Dim xPath เป็นสตริง
Dim xChart เป็น ChartObject
เกี่ยวกับข้อผิดพลาดต่อไป
Dim wydzialy เป็นสตริง
wydzialy = lista.Cells(3, 75)
xChartName = Application.InputBox(wydzialy, "KuTools for Excel", , , , , , , 2) 'Wykres1 '"Please enter the chart name:"
ถ้า xChartName = "" จากนั้นออกจาก Sub
ตั้งค่า xChart = Sheets("Wykresy")).ChartObjects(xChartName) 'เปลี่ยน "Sheet1" เป็นชื่อเวิร์กชีตของคุณ
ถ้า xChart ไม่มีอะไร ให้ออกจาก Sub
xChartPath = Application.ActiveWorkbook.Path & "\" & Environ("USERNAME") & VBA.Format(VBA.Now(), "DD_MM_YY_HH_MM_SS") & ".svg" '.bmp '.svg '.svg ma lepsza jakość
xPath = " "
xChart.Chart.Export xChartPath


Dim OutApp เป็นวัตถุ
Dim OutMail เป็นวัตถุ
ตั้งค่า OutApp = CreateObject ("Outlook.Application")
ตั้งค่า OutMail = OutApp.CreateItem(0)
ด้วย OutMail
.To = อีเมล (ข)
.CC = emails_dw(ข)
.Subject = "XXXX" ' - " & lista.Cells (i, 66)
.Attachments เพิ่ม xChartPath
.HTMLBody = "treść" & xPath

ตั้งค่า .SendUsingAccount = OutApp.Session.Accounts.Item(1)

.แสดง
จบด้วย
ฆ่า xChartPath
ตั้งค่า OutMail = Nothing
ตั้งค่า OutApp = ไม่มีอะไร
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีคูบา
รหัสได้รับการปรับปรุง ผู้รับสามารถดูแผนภูมิได้ตามปกติ กรุณาให้มันลอง
หมายเหตุ: ในรหัสโปรดเปลี่ยน "1 แผนภูมิ" ให้กับชื่อแผนภูมิของคุณเอง และระบุที่อยู่อีเมลในช่องถึง
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
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี ฉันต้องการเพิ่มช่องว่างในเนื้อหาจดหมาย ฉันควรใช้คีย์เวิร์ดใด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี pavan chougule
สองบรรทัดต่อไปนี้ในโค้ดประกอบด้วยเนื้อหาของอีเมล คุณสามารถแก้ไขเนื้อหาอีเมลได้ด้วยตนเองโดยกดปุ่มเว้นวรรคบนแป้นพิมพ์เพื่อเพิ่มช่องว่าง
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>"
มีความคิดเห็นยังไม่มีการโพสต์ที่นี่
แสดงความคิดเห็นของคุณ
โพสต์ในฐานะแขก
×
ให้คะแนนโพสต์นี้:
0   ตัวอักษร
สถานที่แนะนำ

ช่องทางอื่นๆ

ลิขสิทธิ์© 2009 - wwwextendoffice.com | สงวนลิขสิทธิ์. ขับเคลื่อนโดย ExtendOffice. | แผนผังเว็บไซต์
Microsoft และโลโก้ Office เป็นเครื่องหมายการค้าหรือเครื่องหมายการค้าจดทะเบียนของ Microsoft Corporation ในสหรัฐอเมริกาและ / หรือประเทศอื่น ๆ
ได้รับการปกป้องโดย Sectigo SSL