Excel VBA Macro: Resize Range (Table) Pasted As Image In Email Body

Excel VBA Macro: Resize Range (Table) Pasted As Image In Email Body

💥Subscribe:    / @greggowaffles  

Code:

Sub send_email_with_table_and_resize()

Dim OutApp As Object
Dim OutMail As Object
Dim table As Range
Dim pic As Picture
Dim ws As Worksheet
Dim wordDoc

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

'grab table, convert to image, and cut
Set ws = ThisWorkbook.Sheets("Population Data")
Set table = ws.Range("A1:C11")

ws.Activate
table.Copy
Set pic = ws.Pictures.Paste

pic.Select
With Selection
.ShapeRange.LockAspectRatio = msoTrue
'.ShapeRange.Height = 200
'.ShapeRange.Width = 200
End With

pic.Cut

'create email message
On Error Resume Next
With OutMail
.to = "[email protected]"
.CC = ""
.BCC = ""
.Subject = "Country Population Data " & Format(Date, "mm-dd-yy")
.display

Set wordDoc = OutMail.GetInspector.WordEditor
With wordDoc.Range
.pasteandformat wdChartPicture
.insertParagraphafter
.insertParagraphafter
.InsertAfter "Thank you,"
.insertParagraphafter
.InsertAfter "Greg"
End With

.HTMLBody = "＜ BODY style = font-size:11pt; font-family:Arial ＞ " & _
"Hi Team, ＜ p ＞ Please see table below: ＜ p ＞" & .HTMLBody
End With
On Error GoTo 0

Set OutApp = Nothing
Set OutMail = Nothing


End Sub

#ExcelVBA #ExcelMacro