Excel VBA Macro: Save Range (as Image) and Attach to Email

Excel VBA Macro: Save Range (as Image) and Attach to Email
💥Subscribe: / @greggowaffles
Code:
Sub save_range_then_email()
Dim table As Range
Dim myPic As String
Dim myPath As String
Dim ws As Worksheet
Dim cht As ChartObject
Dim lWidth As Long
Dim lHeight As Long
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Set ws = ThisWorkbook.Sheets("S&P 500 Stocks")
Set table = ws.Range("A1:C11")
myPath = "C:\Users\greggowaffles\Documents\KZbin Videos\Test\Pictures\"
myPic = "Best Performing Stocks " & Format(Date, "mm-dd-yy") & " " & _
WorksheetFunction.RandBetween(1000, 9999) & ".jpg"
table.CopyPicture xlScreen, xlPicture
lWidth = table.Width
lHeight = table.Height
Set cht = ws.ChartObjects.Add(Left:=0, Top:=0, Width:=lWidth, Height:=lHeight)
cht.Activate
With cht.Chart
.Paste
.Export Filename:=myPath & myPic, filtername:="JPG"
End With
cht.Delete
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "＜BODY style = font-size: 16pt, font-family: Arial＞" & _
"Hi Team, ＜p＞ Please see attachment.＜p＞" & _
"Thank you,＜br＞Greg"
On Error Resume Next
With OutMail
.to = "[e-mail]"
.CC = ""
.BCC = ""
.Subject = "S&P 500 Top Performing Stocks 2023"
.Display
.HTMLBody = strbody & .HTMLBody
.Attachments.Add myPath & myPic
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
#excelmacro #excelvba

[@deepk82]

This is amazing. Keep doing the good work like this. Very helpful.

[@greggowaffles]

Appreciate the feedback! Thank you!!

[@cloudandsqlwithpython]

Hi good work but when I am run it on pivot chart it create the chart on excel sheet instead of Range Picture showing counts etc

[@greggowaffles]

thanks! i will look into that example

[@greggowaffles]

Hope this helps! kzbin.info/www/bejne/l6vVk6ahidh4gbMsi=9Ps1M3r8ooCcNDmf