While piecing together this code, I was able to get it function properly. Thinking I was done, I submitted it to someone who tried to add it as a personal macro and that was when we realized it didn’t work the same. To verify, I added it as a personal macro on my own computer and it still didn’t work.
I have blindly tried a handful of code additions such as
ThisWorkbook.Activate but have not had success.
Sub RangeToEmailBody() 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(prompt:="Please select the data range:", Type:=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>" _ & "<img src='cid:DashboardFile.jpg'>" 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 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") & "\" & nameFile & ".jpg", "JPG" End With Worksheets(SheetName).ChartObjects(Worksheets(SheetName).ChartObjects.Count).Delete Set xRgPic = Nothing End Sub
I would expect the selected range to show up in the body of the email but as a personal macro, there is no content inside the “picture”.
This is a guess at the problem. If you’re adding this in a personal macro,
ThisWorkbook refers to the personal workbook. I’m guessing your source range is in a different workbook entirely.
To simplify, I’d do something like this, using a temporary new workbook:
Sub createJpg(rng As Range, nameFile As String) Dim tempChartObj As ChartObject Dim tempWb As Workbook Set tempWb = Workbooks.Add Set tempChartObj = tempWb.Sheets(1).ChartObjects.Add(rng.Left, rng.Top, rng.Width, rng.Height) rng.CopyPicture With tempChartObj .Activate .Chart.Paste .Chart.Export Environ$("temp") & "\" & nameFile & ".jpg", "JPG" End With tempWb.Close SaveChanges:=False End Sub
Then call it like this (note that
Call is unnecessary):
createJpg xRg, "DashboardFile"