Chart sometimes exports to a blank .jpg file - excel

Question

This code exports the Range as .jpg to a location that is attached to an email with another module running this.
Sub Export_Dashboard_To_PC()
Dim fileSaveName As Variant, pic As Variant
Application.ScreenUpdating = False
Application.DisplayAlerts = False
FName = ThisWorkbook.Path & "\Dashboard.jpg"
With ThisWorkbook.Sheets("Dashboard")
Sheets("Dashboard").Range(Sheets("BP").Range("AE4")).CopyPicture Appearance:=xlScreen, Format:=xlPicture
Set sht = Sheets.Add
sht.Shapes.AddChart
sht.Shapes.Item(1).Select
Set objChart = ActiveChart
With objChart
.ChartArea.Height = Sheets("Dashboard").Range(Sheets("BP").Range("AE4")).Height
.ChartArea.Width = Sheets("Dashboard").Range(Sheets("BP").Range("AE4")).Width
.ChartArea.Fill.Visible = msoFalse
.ChartArea.Border.LineStyle = xlLineStyleNone
.Paste
.Export Filename:=FName, FilterName:="jpg"
End With
sht.Delete
End With
ActiveSheet.Cells(1, 1).Select
Sheets("BP").Activate
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
It all happens in one and sometimes the code exports the image as a blank and attach it as a blank on the email and sends it. I can see the problem is at the export because when I go to the location of the export and open the .jpg, it shows a blank.
I have stepped through it many times, every time it works.
DoEvents gives me the same results.

Answer 1

I have this kind of routine in my commercial Excel add-in, and I've had to overengineer the stuffing out of it. So I started with your code, cleaned it up a bit (it wouldn't compile with Option Explicit set), and inserted some lines to (a) try to make it work, and (b) figure out where it got hung up. Part of what I did was build the copy/paste into a loop, to get more feedback faster.
Sub Export_Dashboard_To_PC()
' turn these off for testing
'Application.ScreenUpdating = False
'Application.DisplayAlerts = False
Dim RangeToCopy As Range
' fully qualify the ranges
Set RangeToCopy = ThisWorkbook.Worksheets("Dashboard"). _
Range(ThisWorkbook.Worksheets("BP").Range("AE4").Text)
Dim wks As Worksheet
Set wks = ThisWorkbook.Worksheets.Add
'DoEvents ' sometimes needed after Worksheets.Add but apparently not this time
Dim ImgNumber As Long
For ImgNumber = 1 To 20
Dim FName As String
FName = ThisWorkbook.Path & "\Dashboard" & ImgNumber & ".png"
' PNG much better image format than JPG for worksheet images (crisper, half the size)
Dim cht As Chart
Set cht = wks.Shapes.AddChart(, wks.Columns(ImgNumber).Left, wks.Rows(ImgNumber).Top).Chart
' inserted .left and .top so I could see individual charts
'DoEvents ' sometimes needed after Shapes.AddChart but apparently not here
With cht
With .ChartArea
.Height = RangeToCopy.Height
.Width = RangeToCopy.Width
.Fill.Visible = msoFalse
.Border.LineStyle = xlLineStyleNone
End With
DoEvents ' inserted because sometimes Range.CopyPicture throws an error
RangeToCopy.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
' copy as bitmap here, more reliable, rather than convert to bitmap during export
Dim iLoop As Long, MaxLoop As Long
MaxLoop = 10
For iLoop = 1 To MaxLoop
DoEvents ' inserted b/c sometimes clipboard is slow to contain copied object
.Paste
If .Shapes.Count > 0 Then
' yay, image pasted into chart
Debug.Print iLoop
Exit For
End If
If iLoop >= MaxLoop Then
' boo, never succeeded
MsgBox "Export Picture Failed", vbCritical
GoTo ExitSub
End If
Next
'DoEvents
.Export Filename:=FName, FilterName:="png"
'DoEvents
'.Parent.Delete ' don't delete, examine after run
End With
Next
ExitSub:
'wks.Delete ' don't delete, examine after run
ActiveSheet.Cells(1, 1).Select
ThisWorkbook.Worksheets("BP").Activate
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
So what I learned was where I needed to put the DoEvents, and where the big bottleneck occurs. The big bottleneck is getting the range copied into the clipboard. VBA starts the copy, and sometimes the copy takes longer than VBA takes to get to the paste, and VBA isn't patient enough to wait. DoEvents is supposed to make VBA wait, but it doesn't always work that way. If the clipboard is still empty (doesn't yet contain a copy of the range), then nothing is pasted, and the exported chart is blank.
So I put another loop after the copy, and did the paste inside the loop. After the paste, if the chart contained an object, then the paste must have worked, so I proceeded to the export.
Usually (in 14 of 20 big loops) the paste resulted in a shape being added to the chart in the first small loop, but in 2/20, it took as many as 6 or 7 small loops.
So for the final code, this is what I came up with. I had to insert
Application.ScreenUpdating True
before the copy, otherwise the copied range was always blank (a blank shape was pasted into the chart.
Sub Export_Dashboard_To_PC()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim RangeToCopy As Range
' fully qualify the ranges
Set RangeToCopy = ThisWorkbook.Worksheets("Dashboard"). _
Range(ThisWorkbook.Worksheets("BP").Range("AE4").Text)
Dim wks As Worksheet
Set wks = ThisWorkbook.Worksheets.Add
Dim FName As String
FName = ThisWorkbook.Path & "\Dashboard_" & Format(Now, "hhmmss") & ".png"
' PNG much better image format than JPG for worksheet images (crisper, half the size)
Dim cht As Chart
Set cht = wks.Shapes.AddChart.Chart
With cht
With .Parent
.Height = RangeToCopy.Height
.Width = RangeToCopy.Width
End With
With .ChartArea
.Fill.Visible = msoFalse
.Border.LineStyle = xlLineStyleNone
End With
ThisWorkbook.Worksheets("Dashboard").Activate
Application.ScreenUpdating = True ' otherwise copied region blank
DoEvents ' inserted because sometimes Range.CopyPicture throws an error
RangeToCopy.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
Application.ScreenUpdating = False
Dim iLoop As Long, MaxLoop As Long
MaxLoop = 10
For iLoop = 1 To MaxLoop
DoEvents ' inserted b/c sometimes clipboard is slow to contain copied object
.Paste
If .Shapes.Count > 0 Then
' yay, image pasted into chart
Exit For
End If
If iLoop >= MaxLoop Then
' never succeeded
MsgBox "Export Picture Failed", vbCritical
GoTo ExitSub
End If
Next
.Export Filename:=FName, FilterName:="png"
End With
ExitSub:
wks.Delete
ActiveSheet.Cells(1, 1).Select
ThisWorkbook.Worksheets("BP").Activate
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Follow Up
In my production code (which I checked after posting this), I don't ever set
Application.ScreenUpdating = False
I also don't insert a new sheet, instead I put my temporary chart on the active sheet, which contains the range I'm exporting.
And my internal loop is
With .chart
Do Until .Pictures.Count = 1
DoEvents
.Paste
Loop
.Export sExportName
End With
Same thing, except it assumes it will never never get into an infinite loop.

Answer 2

I experienced a similar problem when using VBA to paste an image into a chart object and export it as a jpg file. I noticed there were no issues when I slowly stepped through the code line by line. Additionally, there were no issues when I added a comment box after pasting the image but before exporting as a jpg, forcing the code to pause. This led me to believe the problem was with Excel not having sufficient time to complete the paste procedure before exporting the image file.
I solved the issue by adding a 3-second loop between pasting and exporting. I also turned on Screen Updating.
Dim time1, time2
time1 = Now
time2 = Now + TimeValue("0:00:03")
Do Until time1 >= time2
DoEvents
time1 = Now()
Loop