I Can't Have my Chart Objects Pasted Before my Email Signature

[John Massak]

Good evening/Morning.

well i have had written a macro Code that would Copy Charts for Team Performance and Paste it an Email , i have had all things good but i don't know why the graphs are pasted after my Signature as shown in attachment

if anyone can help i would be grateful i need two things

*Paste the chart before my Signature and after my Strbody
*Another things in my dashboard i can't copy the Slicers attached is a print screen of my dashboard as Well i want to copy the Slicers with the Graphs to be pasted in the Email


Slicer Names to be copied are All Available Slicers in the Sheet

Slicer_Employeeinfo
Slicer_Employee_Name
Slicer_FTE
Slice_Hiring_Date
Slicer_Iex
Slicer_Login_ID
Slicer_Mobile_Number
Slicer_Has_Laptop?
Slicer_NPSKPI
Slicer_RCSKPI

 

[John Massak]

Sub SendChartObject()

'Declare Outlook Variables
Dim oLookApp As outlook.Application
Dim oLookFdr As outlook.Folder
Dim oLookNsp As outlook.Namespace
Dim oLookItm As outlook.MailItem
Dim strbody
Dim SigString As String
Dim Signature As String





'Declare Excel Variables
Dim ChrObj As ChartObject

On Error Resume Next

'Test if Outlook is Open
Set oLookApp = GetObject(, "Outlook.Application")

'If the Application isn't open it will return a 429 error
If Err.Number = 429 Then

'If it is not open then clear the error and create a new instance of Outlook
Err.Clear
Set oLookApp = New outlook.Application

End If

'Create a mail item in outlook.
Set oLookItm = oLookApp.CreateItem(olMailItem)


'Defined Data John Massak

strbody = "Dear " & Sheet4.Range("AL6") & "<br>" & "<br>" & _
" &nbsp; &nbsp; &nbsp; &nbsp;&nbsp; Please Have a Look on Your <B><U>SC Monthly Performance </B></U> & <B><U>Please Make Sure to Focus on It</B></U> & <font color=""red""><B><U>Wish you Best of Luck in This Year &#9786; </B></U></font>" & "<br>" & "<br>"
SigString = Environ("appdata") & _
"\Microsoft\Signatures\aspiring.htm"

If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If

On Error Resume Next





'With the new email we just created.
'.HTMLBody = strbody & RangetoHTML(myRng) & Signature
With oLookItm



'Define basic infromation about the email

.To = Sheet4.Range("AL5").Value
.CC = ""
.Subject = Sheet4.Range("AL7") & " Monthly Performance "
' .Body = "Dear " & Sheet4.Range("AL6") & vbCr & vbCr & "Please find Below Your Current Monthly Performance .," & vbCr & "Please let me know if you need any further assistance." & vbCr & vbCr & vbCr
.HTMLBody = strbody & "<br>" & "<br>" & "<br>" & Signature



'Show the new email.
.Display





'Get the Word Editor
Set oWdEditor = .GetInspector.WordEditor

'Loop through each chart in the active sheet
For Each ChrObj In ActiveSheet.ChartObjects

'Copy the Chart


ChrObj.Chart.ChartArea.Copy

'Define the range, insert a blank line, collapse the selection.
Set oWdRng = oWdEditor.Application.ActiveDocument.Content
oWdRng.InsertBefore
oWdRng.Collapse Direction:=wdCollapseEnd

'Paste the object.
oWdRng.Paste


With oWdEditor
With .InlineShapes(.InlineShapes.Count)
.LockAspectRatio = msoFalse
.Width = 250
.Height = 200
End With
End With



Next

End With

End Sub



Function GetBoiler(ByVal sFile As String) As String
'**** Kusleika
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function

 

[John Massak]

Can anyone help