T
thedanielgreen
I am trying to paste an excel shart in the body of an outlook message.
I already managed to do this through exporting the chart and then
importing, but the chart loses a lot of quality so I am trying to find
a way to paste the chart through the clipboard.
the only thing missing in my code would be the procedure to paste the
chart that is already on the clipboard. here's what I have:
Sub SendEmail()
Dim theApp, theNameSpace, theMailItem, myAttachment, Msg
'create a new Outlook Application Object,
'direct it to the proper NameSpace,
'create a new Mail Item and set the attachments collection
Set theApp = CreateObject("Outlook.Application")
Set theNameSpace = theApp.GetNamespace("MAPI")
Set theMailItem = theApp.CreateItem(0)
Set myAttachment = theMailItem.Attachments
theMailItem.Display
' campo mensagem '
Workbooks.Open "Test.xls"
Sheets("Sheet1").Select
ActiveSheet.ChartObjects("Grafico").Activate
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen,
Format:=xlPicture
Sheets("Sheet1").Cells(1, 1).Select
'add recipients to MailItem
theMailItem.Recipients.Add "(e-mail address removed)"
theMailItem.subject = "Anything"
theMailItem.Body = Msg
theMailItem.Send
theNameSpace.Logoff
End Sub
I found the code below on this same newsgroup that supposedly would do
the job, but it is not working. Does anyone know why?
Sub Pastebody()
Set tmpBody =
Item.GetInspector.ModifiedFormPages("Message").Controls("Message")
tmpBody.SetFocus
Item.GetInspector.CommandBars.Item("Menu
Bar").Controls("Edit").Controls("Paste").Execute
End Sub
Thanks
I already managed to do this through exporting the chart and then
importing, but the chart loses a lot of quality so I am trying to find
a way to paste the chart through the clipboard.
the only thing missing in my code would be the procedure to paste the
chart that is already on the clipboard. here's what I have:
Sub SendEmail()
Dim theApp, theNameSpace, theMailItem, myAttachment, Msg
'create a new Outlook Application Object,
'direct it to the proper NameSpace,
'create a new Mail Item and set the attachments collection
Set theApp = CreateObject("Outlook.Application")
Set theNameSpace = theApp.GetNamespace("MAPI")
Set theMailItem = theApp.CreateItem(0)
Set myAttachment = theMailItem.Attachments
theMailItem.Display
' campo mensagem '
Workbooks.Open "Test.xls"
Sheets("Sheet1").Select
ActiveSheet.ChartObjects("Grafico").Activate
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen,
Format:=xlPicture
Sheets("Sheet1").Cells(1, 1).Select
'add recipients to MailItem
theMailItem.Recipients.Add "(e-mail address removed)"
theMailItem.subject = "Anything"
theMailItem.Body = Msg
theMailItem.Send
theNameSpace.Logoff
End Sub
I found the code below on this same newsgroup that supposedly would do
the job, but it is not working. Does anyone know why?
Sub Pastebody()
Set tmpBody =
Item.GetInspector.ModifiedFormPages("Message").Controls("Message")
tmpBody.SetFocus
Item.GetInspector.CommandBars.Item("Menu
Bar").Controls("Edit").Controls("Paste").Execute
End Sub
Thanks