Let’s say I have 20 different team members, and I want to mail them their progress charts and just to impress my manager keep him in CC.

Capture

Let’s start with the already created file that has charts created. The only change in the code we will make is that charts will have the names of employees in the title.

Dont worry ,we go the code by recording the same over any chart, See Macro2

ActiveChart.ChartTitle.Select
ActiveChart.ChartTitle.Text = SummarySheet.Cells(StartRow, 1)

make-new-charts-vba

Capture2.JPG

Let’s go over to Rob’s wonderful site and get the code to mail a chart

Mail chart or chart sheet as picture

we will need to embed the code in “Sub SaveSend_Embedded_Chart” into our “MakeCharts” so as to mail the charts as they are created.

‘————————————————–

Sub MakeCharts()
Dim ChartSheet As Worksheet
Dim SummarySheet As Worksheet
Dim SourceSheet As Worksheet

‘——————-
‘ This code is from Rob
Dim OutApp As Object
Dim OutMail As Object
Dim Fname As String

‘——————-
Set SummarySheet = ActiveWorkbook.Worksheets(“Summary VBA”)
Set SourceSheet = ActiveWorkbook.Worksheets(“Data”)

Reps_Column = getColFromAddr(getAddress(SourceSheet, “Rep”))
EmailID_Column = getColFromAddr(getAddress(SourceSheet, “EmailID”))

Sheets.Add

Set ChartSheet = ActiveWorkbook.Worksheets(ActiveSheet.Name)

ChartSheet.Name = “Charts – VBA”

StartRow = 0

For i = 2 To SummarySheet.UsedRange.Rows.Count

If StartRow = 0 Then StartRow = i

If SummarySheet.Cells(i + 1, 1) <> “” Then

EndRow = i
MySelection = “‘” & SummarySheet.Name & “‘!” & “$B$” & StartRow & “:$D$” & EndRow

‘ The macro autocode here
ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
ActiveChart.SetSourceData Source:=Range(MySelection)
‘ See how we programmed MySelection above

ActiveChart.ChartTitle.Select
ActiveChart.ChartTitle.Text = SummarySheet.Cells(StartRow, 1)

‘ActiveChart.Name = SummarySheet.Cells(StartRow, 1)

‘ Lets find the email id

For k = 2 To SourceSheet.UsedRange.Rows.Count

If SourceSheet.Cells(k, Reps_Column) = SummarySheet.Cells(StartRow, 1) Then

EmailID = SourceSheet.Cells(k, EmailID_Column)

Exit For
End If
Next k

‘——————-
‘ This code is from Rob

‘ see how we relaced the strings to variables

Set OutApp = CreateObject(“Outlook.Application”)
Set OutMail = OutApp.CreateItem(0)

‘File path/name of the gif file
Fname = Environ$(“temp”) & “\My_Sales1.gif”
ActiveWorkbook.Worksheets(ChartSheet.Name).ChartObjects(ActiveChart.Parent.Name).Chart.Export _
Filename:=Fname, FilterName:=”GIF”
sFileName = Split(Fname, “\”)(UBound(Split(Fname, “\”)))

On Error Resume Next
With OutMail
.To = EmailID
.CC = “myManager@xyz.com”
.BCC = “”
.Subject = “Daily Report – ” & SummarySheet.Cells(StartRow, 1)
‘.Body = “Hi ” & SummarySheet.Cells(StartRow, 1)
.Attachments.Add Fname, olByValue, 0

‘Now add it to the Html body using image name
‘change the src property to ‘cid:your image filename’
‘it will be changed to the correct cid when its sent.
.HTMLBody = .HTMLBody & “<br><B>Embedded Image:</B><br>” _
& “<img src=’cid:” & Replace(sFileName, ” “, “%20”) & “‘” _
& “width=’500′ height=’200’><br>” _
& “<br>Best Regards, <br>My Name</font></span>”

‘.Send ‘or use
.Display
End With
On Error GoTo 0

‘Delete the gif file
Kill Fname
Set OutMail = Nothing
Set OutApp = Nothing

‘——————-

StartRow = 0
EndRow = 0
EmailID = “”

End If

Next i
numChartsInAColumn = 2
nCount = 0

For Each myChart In ActiveSheet.ChartObjects
myChart.Width = 450
myChart.Height = 200

myChart.Top = (nCount Mod numChartsInAColumn) * myChart.Height + 1
myChart.Left = Int(nCount / numChartsInAColumn) * myChart.Width + 1

nCount = nCount + 1
Next
End Sub

‘———————————————————

Voila, we have emails created.

Here is the file with full code, Remember to delete the summary and chart sheet before you begin.

Make and Mail new Charts – VBA.

Cheers

CuriousJatin

 

 

Advertisements