Sub ExportPic(fname$)
Dim MyChart$, MyPicture$, PicWidth&, PicHeight&, sr As ShapeRange
Set sr = ActiveSheet.Shapes.Range(Array("imagem 7")) ' desired picture
Application.ScreenUpdating = False
MyPicture = sr.Name
PicHeight = sr.Height: PicWidth = sr.Width
Charts.Add
ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1"
Selection.Border.LineStyle = 0
MyChart = Selection.Name & " " & Split(ActiveChart.Name, " ")(2)
With ActiveSheet
With .Shapes(MyChart)
.Width = PicWidth
.Height = PicHeight
End With
.Shapes(MyPicture).Copy
With ActiveChart
.ChartArea.Select
.Paste
End With
.ChartObjects(1).Chart.Export Filename:=fname, FilterName:="jpg"
.Shapes(MyChart).Cut
End With
Application.ScreenUpdating = True
End Sub
Sub mail()
Dim myitem As MailItem, olApp, fname$
fname = "c:\pub\Pic30.jpg"
ExportPic fname ' from sheet to hard disk
Set olApp = CreateObject("Outlook.Application")
Set myitem = olApp.CreateItem(olMailItem)
With myitem
.To = "nice@educated.com"
.cc = ""
.Subject = "Free Help"
.Attachments.Add fname, 1, 0
.HTMLBody = "<html><p>Summary of Status.</p>" & _
"<img src=""cid:" & Split(fname, "\")(2) & """height=520 width=750>"
.Display
End With
Set myitem = Nothing: Set olApp = Nothing
End Sub
