email chart
 

I am using this code in an attempt to email a chart... it doesn't copy the
chart... and I want to include some cells in that range as well so I don't
want to just copy the chart... any thoughts?

Public Function RangetoHTML()
' You can't use this function in Excel 97
Dim fso As Object
Dim ts As Object
Dim TempFile As String
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") &
".htm"
With ActiveWorkbook.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=ActiveSheet.Name, _
source:=Selection.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
Set ts = Nothing
Set fso = Nothing
Kill TempFile
End Function

Sub emailcharts()

Application.ScreenUpdating = False
Sheets("force").Select
Range("a1:r45").Select

Dim source As Range
'Dim OutApp As Outlook.Application
'Dim OutMail As Outlook.MailItem

Set source = Nothing
On Error Resume Next
Set source = Selection
On Error GoTo 0
If source Is Nothing Then
MsgBox "The selection is not a range or the sheet is protect" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If

If ActiveWindow.SelectedSheets.Count 1 Or _
Selection.Cells.Count = 1 Or _
Selection.Areas.Count 1 Then
MsgBox "An Error occurred :" & vbNewLine & vbNewLine & _
"You have more than one sheet selected." & vbNewLine & _
"You only selected one cell." & vbNewLine & _
"You selected more than one area." & vbNewLine & vbNewLine & _
"Please correct and try again.", vbOKOnly
Exit Sub
End If

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Force Index" & " " & Range("k22").Value
.HTMLBody = RangetoHTML
.display 'or use .Display
End With

Set OutMail = Nothing
Set OutApp = Nothing
Application.ScreenUpdating = True
Range("a1").Select
End Sub

email chart
 

Hi John

No pictures or charts in this example

For only charts see
http://www.rondebruin.nl/mail/folder2/chart.htm

For chart and text see
http://support.microsoft.com/default...b;en-us;816644



--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"John" wrote in message ...
I am using this code in an attempt to email a chart... it doesn't copy the
chart... and I want to include some cells in that range as well so I don't
want to just copy the chart... any thoughts?

Public Function RangetoHTML()
' You can't use this function in Excel 97
Dim fso As Object
Dim ts As Object
Dim TempFile As String
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") &
".htm"
With ActiveWorkbook.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=ActiveSheet.Name, _
source:=Selection.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
Set ts = Nothing
Set fso = Nothing
Kill TempFile
End Function

Sub emailcharts()

Application.ScreenUpdating = False
Sheets("force").Select
Range("a1:r45").Select

Dim source As Range
'Dim OutApp As Outlook.Application
'Dim OutMail As Outlook.MailItem

Set source = Nothing
On Error Resume Next
Set source = Selection
On Error GoTo 0
If source Is Nothing Then
MsgBox "The selection is not a range or the sheet is protect" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If

If ActiveWindow.SelectedSheets.Count 1 Or _
Selection.Cells.Count = 1 Or _
Selection.Areas.Count 1 Then
MsgBox "An Error occurred :" & vbNewLine & vbNewLine & _
"You have more than one sheet selected." & vbNewLine & _
"You only selected one cell." & vbNewLine & _
"You selected more than one area." & vbNewLine & vbNewLine & _
"Please correct and try again.", vbOKOnly
Exit Sub
End If

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Force Index" & " " & Range("k22").Value
.HTMLBody = RangetoHTML
.display 'or use .Display
End With

Set OutMail = Nothing
Set OutApp = Nothing
Application.ScreenUpdating = True
Range("a1").Select
End Sub