VBA Email Formatting - Charts and Tables

[oddzac]

Hello friends, I'm back with more nonsense questions on using VBA to build automated reports.

My team and I have been manually building a daily email to track KPIs for months.
The particular email that I'm working with now has pivot tables and charts associated with them that I'd like to pull into the email side-by-side and resize so that they match heights.
This may be asking too much of VBA but here are some examples of how we've been manually building the report:


IDEAL FORMAT:

Here, my process has been to copy the chart over as a Chart Object (to preserve scroll-over data callouts), paste to email, copy the PivotTable as a picture, paste beside the chart and resize




This is how it looks in my spreadsheet:

RAW FORMAT:

I've got a few dozen hours of VBA under my belt but am still very much a novice when it comes to Excel-to-Outlook interactions.
My current working module is a very rough framework that only copies the tables over because I couldn't figure out how to pull the charts in a way that makes sense and preserves formatting.

I'm really hoping for breadcrumbs at the very least with my key complications being:

- VBA formula for copying specific chart objects
- How to paste a picture in the same line as that chart? (current module seems to overwrite the line unless I insert a new one)
- Can I use VBA to resize a pasted image to match height of said chart?

Current Code (results not pretty):

Sub WSSW_Email()



    Dim rng As Range
    Dim OutApp As Object
    Dim outMail As Object
    Dim Location As String
    Dim Signature As String
    
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
    'Call PDFActiveSheet
    'Call Webpost
    
    
    
'Save Workbook
    
    ActiveWorkbook.Save
    


'Open new mail item

    Dim outlookApp As Object
    Set outlookApp = CreateObject("Outlook.Application")
    Set outMail = outlookApp.CreateItem(0)
    
'Get Word editor

    outMail.Display
    Dim wordDoc As Object
    Set wordDoc = outMail.GetInspector.WordEditor
    
    
    
'Save Sig

    With wordDoc
        
        
        wordDoc.Range.Paragraphs.Alignment = 1
        wordDoc.Range.Paragraphs.Add
        wordDoc.Paragraphs.first.Range.InsertParagraphBefore
    
    End With

    
'Copy contents

    Sheets("WSSW").Select
    Range("I2:L20").Select
    Range("I2").Activate
    Selection.Copy



'Paste as image (Centered)
    
    Dim insertPoint As Object
    wordDoc.Paragraphs.first.Range.InsertParagraphBefore 'Create new empty paragraph before signature
    Set insertPoint = wordDoc.Paragraphs.first
    insertPoint.Range.InsertParagraphBefore 'Create another
    insertPoint.Previous.Range.PasteAndFormat Type:=wdChartPicture
    
    With wordDoc.Tables(1).Rows
        .WrapAroundText = 0 'If this is true does not work
        .Alignment = 1
    End With

'======== SECOND TABLE ========
'Copy contents (2)


    Sheets("WSSW").Select
    Range("U2:V12").Select
    Range("U2").Activate
    Selection.Copy

   
'Paste as image (Centered)(2)
    
    insertPoint.Range.InsertParagraphBefore 'Create new empty paragraph before signature
    insertPoint.Range.InsertParagraphBefore 'Create another
    insertPoint.Previous.Range.PasteAndFormat Type:=wdChartPicture
    
    
    With wordDoc.Tables(2).Rows
        .WrapAroundText = 0 'If this is true does not work
        .Alignment = 1
    End With
    

'======== THIRD TABLE ========
'Copy contents (2)

    Sheets("WSSW").Select
    Range("O2:P30").Select
    Range("O2").Activate
    Selection.Copy

   
'Paste as image (Centered)(2)
    
    insertPoint.Range.InsertParagraphBefore 'Create new empty paragraph before signature
    insertPoint.Range.InsertParagraphBefore 'Create another
    insertPoint.Previous.Range.PasteAndFormat Type:=wdChartPicture
    
    
    With wordDoc.Tables(3).Rows
        .WrapAroundText = 0 'If this is true does not work
        .Alignment = 1
    End With


'======== FOURTH TABLE ========
'Copy contents (4)
    
    Sheets("WSSW").Select
    ActiveSheet.ListObjects("Table7").Range.AutoFilter Field:=5, Criteria1:= _
        "<1", Operator:=xlAnd
    Range("A2:H30").Select
    Range("A2").Activate
    Selection.Copy
   
   
'Paste as image (Centered)(4)
    
    insertPoint.Range.InsertParagraphBefore 'Create new empty paragraph before signature
    insertPoint.Range.InsertParagraphBefore 'Create another
    insertPoint.Previous.Range.PasteAndFormat Type:=wdChartPicture
     ActiveSheet.ListObjects("Table7").Range.AutoFilter Field:=5
    
    With wordDoc.Tables(4).Rows
        .WrapAroundText = 0 'If this is true does not work
        .Alignment = 1
    End With



'Insert Addresses and Subject

    With outMail
        .To = Sheets("Setup").Range("B1").Value
        .CC = Sheets("Setup").Range("B2").Value
        .Subject = Sheets("Setup").Range("I5").Value & " " & Sheets("Setup").Range("I6").Value
        .Attachments.Add ActiveWorkbook.FullName
        
        
        .Display
    End With
    
    Range("J6").Activate
    
cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True

End Sub

Thanks!
-Z