# Resizing a range of cells and copy and paste to an email using vba



## Patches01 (Dec 17, 2022)

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.


----------

