Hello All -
The following macro works if I step through it but if I just execute it in normal mode it mails a blank picture instead of the actual picture. I'm not that familiar with the code itself and am just managing a workbook that was left to me at work. The code worked fine as is in 2013, but we just upgraded to 2016 and it no longer works. The problem appears to be in the bolded section - beginning Set co = . When stepping through, this is where the picture is filled in. Any help on what the issue is, why it worked in 2013 but not in 2016, or how to fix it would be much appreciated.
The following macro works if I step through it but if I just execute it in normal mode it mails a blank picture instead of the actual picture. I'm not that familiar with the code itself and am just managing a workbook that was left to me at work. The code worked fine as is in 2013, but we just upgraded to 2016 and it no longer works. The problem appears to be in the bolded section - beginning Set co = . When stepping through, this is where the picture is filled in. Any help on what the issue is, why it worked in 2013 but not in 2016, or how to fix it would be much appreciated.
Code:
Sub DPPEmail()
Application.EnableEvents = False
Application.ScreenUpdating = False
Call UnProtectAll
Application.ScreenUpdating = True
'===================================================
' Export Range as PNG file
'===================================================
'''' Set Range you want to export to file
Dim r As Range
Dim co As ChartObject
Dim picFile As String
Dim sCellVal As String
Dim sTo As String
Dim sTo2 As String
Dim emailRng As Range
Dim cl As Range
Sheets("Daily Plan").Select
Set EmailTo = Worksheets("Daily Plan").Range("O6:O12")
For Each cl In EmailTo
If cl.Value <> "" Then sTo = sTo & cl.Value & "; "
Next
Set r = Worksheets("Daily Plan").Range("A1:K21")
''' Copy range as picture onto Clipboard
r.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
picFile = Environ("Temp") & "\TempExportChart.png"
''' Create an empty chart with exact size of range copied
[B] Set co = r.Parent.ChartObjects.Add(Left:=r.Left, Top:=r.Top, Width:=r.Width, Height:=r.Height)
With co[/B]
''' Paste into chart area, export to file, delete chart.
.Chart.Paste
.Chart.Export picFile
.Delete
End With
'===================================================
' Create Email and Import Picture
'===================================================
'send out the email
Dim OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
Dim OutMail As Object
Set OutMail = OutApp.CreateItem(olMailItem)
Dim signature As String
Dim strBody As String
' Subject location
OutMail.Display
signature = OutMail.HTMLBody
strBody = "******>[IMG]https://www.mrexcel.com/forum/newthread.php?do=postthread&f=10[/IMG]"
On Error Resume Next
With OutMail
.To = sTo
.CC = sTo2
.BCC = ""
.Subject = "SDF6 IB " & Worksheets("Daily Plan").Range("b8")
.HTMLBody = strBody & vbNewLine & signature
.Attachments
.Send
End With
Kill picFile
On Error GoTo 0
'Tidy Up
Set OutMail = Nothing
Set OutApp = Nothing
Set co = Nothing
Set r = Nothing
Application.ScreenUpdating = False
Call ProtectAll
Application.ScreenUpdating = True
Application.EnableEvents = True
Call StopTimer
Call StartTimer
Sheets("Daily Plan").Select
Range("A1").Select
MsgBox "You have successfully emailed the plan!"
End Sub