我能夠完成我發佈的任務。我張貼下面的最終代碼的人誰可能需要幫助的將來在類似的行...
PS：
- 我已經分成不同的組，方便使用。請複製每個代碼和「模塊」在其粘貼在背靠背
- 薄片名應該是「RAWDATA」和「ReportData」
- 的表應該被放置在片材「RAWDATA」和列報頭應在排5
- 在片材 「RAWDATA」，以K列，郵件ID提到
宏＃1
Option Explicit
Dim folder_path As String
Dim chart_no As Integer
Dim file_path As String
Sub mail_2_IBUhead()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim rng As Range
Dim x As Integer, y As Integer
Dim total_Resource As Integer
Application.ScreenUpdating = False
Sheets("RawData").Select
Call export_chart
Call Send_Automate_Mail
Sheets("RawData").Select
Range("A1").Select
'Delete the htm file we used in this function
Kill file_path & "Chart_1.png"
MsgBox "Draft Mails have been generated", vbDefaultButton1, "Mail Drafted!!!"
End Sub
宏＃2：
Private Sub Send_Automate_Mail()
' This macro would only send the mail...
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim strbody_1 As String, strbody_2 As String, strbody_3 As String
Dim Start_row As Integer, Start_column As Integer, End_row As Integer, End_Column As Integer
' selecting the entire table range in the sheet
Sheets("RawData").Select
Range("A5").Select
Start_row = Selection.Row
Start_column = Selection.Column
Selection.End(xlToRight).Select
End_Column = Selection.Column
Range("A5").End(xlDown).Select
End_row = Selection.Row
Range(Cells(Start_row, 1), Cells(End_row, End_Column)).Select
Set rng = Selection.SpecialCells(xlCellTypeVisible)
If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected. " & _
vbNewLine & "Please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody_1 = "<BODY style=font-size:11pt;font-family:Calibri>Dear User,<p>" & _
" Below is the Graph.... <br> </BODY> "
strbody_2 = "<BODY style=font-size:11pt;font-family:Calibri>" & _
" Below is the Table... <br> </BODY> "
strbody_3 = "<BODY style=font-size:11pt;font-family:Calibri> This is an Automated mail. Please do not respond. <p> <p> " & _
" Regards, <br> Sender </BODY> "
file_path = folder_path & "\"
With OutMail
.To = Sheets("RawData").Range("k6").Value
.CC = ""
.BCC = ""
.Subject = "BE. RawData"
.Attachments.Add file_path & "Chart_1.png"
.htmlbody = strbody_1 & "<p>" & "<p>" & _
"<img src='cid:Chart_1.png'" & "width='1000' height='580'>" & "<br>" & "<p>" & _
strbody_2 & "<p>" & _
RangetoHTML(rng) & "<br>" & _
strbody_3
.Importance = 2
' display the e-mail message, change it to ".send" to send the mail on running the macro
.Display
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
宏＃3：
Function RangetoHTML(rng As Range)
' this function is used in code "Send_Automate_Mail"
' do not change the code if you are new to coding :)
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
'Copy the range and create a new workbook to past the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With
'Publish the sheet to a htm file
With TempWB.PublishObjects.Add(_
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", "align=left x:publishsource=")
TempWB.Close savechanges:=False
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
宏＃4：
Private Sub export_chart()
' this code will export all the graphs present in the sheet
Dim objCht As ChartObject
Dim x As Integer
folder_path = Application.ActiveWorkbook.Path
' for each graph present in the sheet, it will get exported
Sheets("ReportData").Select
x = 1
For Each objCht In ActiveSheet.ChartObjects
objCht.Chart.Export folder_path & "\Chart_" & x & ".png", "PNG"
x = x + 1
Next objCht
End Sub
感謝， 注：Kunal ...
我覺得CopyAsPicture或圖片，不知道會有所幫助。 –
這是一個非常複雜的問題，包括（1）將圖表導出到圖像（2）將表格導出到圖像（3）將圖像附加到電子郵件（4）格式電子郵件（可能使用HTML（5））。所以，我建議你把你的問題分成幾個帖子。然而，至少有一些前面提到的有很多答案已經可以在這個網站上找到：http://stackoverflow.com/questions/11939087/export-chart-as-image-with-click-of-a-按鈕或http://stackoverflow.com/questions/36058862/how-to-embed-image-placed-inside-the-excel-into-the-htmlbody-of-vbascript/36060411#36060411 – Ralph
@ Ralph ...好的將做到這一點，並感謝鏈接... – Kunal