Bunu uyarlayıncada eklerim forma.
Sub ChartToOutlook_single()
'Microsoft outlook 16.0 object libary secilmali
Dim oLookApp As Outlook.Application
Dim oLookFdr As Outlook.Folder
Dim oLookNsp As Outlook.Namespace
Dim oLookItm As Outlook.MailItem
On Error Resume Next
Set oLookApp = GetObject(, "Outlook.Application")
If Err.Number = 429 Then
Err.Clear
Set oLookApp = New Outlook.Application
End If
On Error GoTo 0
ActiveSheet.Shapes("mailResim").Copy
Set oLookItm = oLookApp.CreateItem(olMailItem)
With oLookItm
.To = "[email protected]"
.Subject = "Test"
.Body = "Dear Mr Lee" & vbNewLine
.Display
Set oWdEditor = .GetInspector.WordEditor
Set oWdRng = oWdEditor.Application.ActiveDocument.Content
oWdRng.InsertAfter " " & vbNewLine & vbNewLine & vbNewLine
oWdRng.Collapse Direction:=wdCollapseEnd
oWdRng.Paste
End With
End Sub