Hi All
I want to resize a range of cells and copy and paste them to an email using a vba.
This is where I am at so far.
Private Sub CommandButton3_Click()
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("Sheet1")
Set table = ws.Range("A1:J25")
ws.Activate
table.Copy
Set pic = ws.Pictures.Paste
pic.Cut
'create email message
On Error Resume Next
With OutMail
.to = ""
.CC = ""
.BCC = ""
.Subject = "Daily Gaming Figures "
.Display
Set wordDoc = OutMail.GetInspector.WordEditor
With wordDoc.Range
.PasteAndFormat wdChartPicture
.InsertParagraphAfter
.InsertParagraphAfter
.InsertAfter ""
.InsertParagraphAfter
.InsertAfter ""
End With
.HTMLBody = "<BODY style = font-size:11pt; font-family:Calibri >" & _
"Good morning Mazen & Chris, <p> Please find below the Daily Gaming Figures for your viewing: <p>" & .HTMLBody
End With
On Error GoTo 0
Set OutApp = Nothing
Set OutMail = Nothing
End Sub
Any suggestions would be greatly appreciated.
I want to resize a range of cells and copy and paste them to an email using a vba.
This is where I am at so far.
Private Sub CommandButton3_Click()
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("Sheet1")
Set table = ws.Range("A1:J25")
ws.Activate
table.Copy
Set pic = ws.Pictures.Paste
pic.Cut
'create email message
On Error Resume Next
With OutMail
.to = ""
.CC = ""
.BCC = ""
.Subject = "Daily Gaming Figures "
.Display
Set wordDoc = OutMail.GetInspector.WordEditor
With wordDoc.Range
.PasteAndFormat wdChartPicture
.InsertParagraphAfter
.InsertParagraphAfter
.InsertAfter ""
.InsertParagraphAfter
.InsertAfter ""
End With
.HTMLBody = "<BODY style = font-size:11pt; font-family:Calibri >" & _
"Good morning Mazen & Chris, <p> Please find below the Daily Gaming Figures for your viewing: <p>" & .HTMLBody
End With
On Error GoTo 0
Set OutApp = Nothing
Set OutMail = Nothing
End Sub
Any suggestions would be greatly appreciated.
