G
Guest
I have tried mailing sheets using the code at the bottom.
Code taken from Ron DeBruin's web site:
http://www.rondebruin.nl/sendmail.htm
It works fine for sheets. However, I am interested in
sending charts instead of sheets.
I can send individual charts but would like to group them
into multiple pages of charts in one workbook.
Suggestions?
Ken
Sub Mail_sheets()
Dim MyArr As Variant
Dim last As Long
Dim shname As Long
Dim a As Integer
Dim Arr() As String
Dim N As Integer
Dim strdate As String
Dim wb As Workbook
For a = 1 To 253 Step 3
If ThisWorkbook.Sheets("mail"). _
Cells(1, a).Value = "" Then Exit Sub
Application.ScreenUpdating = False
strdate = Format(Now, "dd-mm-yy h-mm-ss")
With ThisWorkbook.Sheets("mail")
MyArr = .Range(.Cells(1, a + 1), _
..Cells(Rows.Count, a + 1).End(xlUp))
End With
last = ThisWorkbook.Sheets("mail").Cells
(Rows.Count, a).End(xlUp).Row
N = 0
For shname = 1 To last
N = N + 1
ReDim Preserve Arr(1 To N)
Arr(N) = ThisWorkbook.Sheets("mail").Cells
(shname, a).Value
Next shname
ThisWorkbook.Worksheets(Arr).Copy
Set wb = ActiveWorkbook
With wb
.SaveAs "Part of " & ThisWorkbook.Name _
& " " & strdate & ".xls"
.SendMail MyArr, ThisWorkbook.Sheets
("mail").Cells(1, a + 2).Value
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
Application.ScreenUpdating = True
Next a
End Sub
Code taken from Ron DeBruin's web site:
http://www.rondebruin.nl/sendmail.htm
It works fine for sheets. However, I am interested in
sending charts instead of sheets.
I can send individual charts but would like to group them
into multiple pages of charts in one workbook.
Suggestions?
Ken
Sub Mail_sheets()
Dim MyArr As Variant
Dim last As Long
Dim shname As Long
Dim a As Integer
Dim Arr() As String
Dim N As Integer
Dim strdate As String
Dim wb As Workbook
For a = 1 To 253 Step 3
If ThisWorkbook.Sheets("mail"). _
Cells(1, a).Value = "" Then Exit Sub
Application.ScreenUpdating = False
strdate = Format(Now, "dd-mm-yy h-mm-ss")
With ThisWorkbook.Sheets("mail")
MyArr = .Range(.Cells(1, a + 1), _
..Cells(Rows.Count, a + 1).End(xlUp))
End With
last = ThisWorkbook.Sheets("mail").Cells
(Rows.Count, a).End(xlUp).Row
N = 0
For shname = 1 To last
N = N + 1
ReDim Preserve Arr(1 To N)
Arr(N) = ThisWorkbook.Sheets("mail").Cells
(shname, a).Value
Next shname
ThisWorkbook.Worksheets(Arr).Copy
Set wb = ActiveWorkbook
With wb
.SaveAs "Part of " & ThisWorkbook.Name _
& " " & strdate & ".xls"
.SendMail MyArr, ThisWorkbook.Sheets
("mail").Cells(1, a + 2).Value
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
Application.ScreenUpdating = True
Next a
End Sub