Exporting data and charts from Excel Worksheets to JPG

Question

I am trying to automate the process of exporting a series of Excel Worksheets to JPEG.

The Sheets in question are monitoring points for borehole logs, containing both information in cells as well as charts showing trends. The exported JPEGs will be used in reports.

I have taken the code from here: Using VBA Code how to export excel worksheets as image in Excel 2003?

Modified it slightly to meet my needs. The script captures the worksheets in an array, and steps through the array setting the print area dynamically to allow the original code to run as intended.

    Sub ExportImage()

'Place all worksheets in an array

Dim ShtNames() As String
ReDim ShtNames(1 To ActiveWorkbook.Sheets.Count)
For i = 1 To Sheets.Count
ShtNames(i) = Sheets(i).Name
Next i

Dim sFilePath As String
Dim sView As String


i = 1

'step through each worksheet to export to JPG

Do Until i = Sheets.Count + 1
    Sheets(Sheets(i).Name).Activate

    Sheets(Sheets(i).Name).UsedRange.Select
    ActiveSheet.PageSetup.PrintArea = Selection.Address

'Credit to Winand and Ryan from this link https://stackoverflow.com/questions/16143877/using-vba-code-how-to-export-excel-worksheets-as-image-in-excel-2003/28541252

'Captures current window view
    sView = ActiveWindow.View

'Sets the current view to normal so there are no "Page X" overlays on the image
    ActiveWindow.View = xlNormalView

'Temporarily disable screen updating
    Application.ScreenUpdating = True

    Set Sheet = ActiveSheet

'Set the file path to export the image to the user's desktop
'I have to give credit to Kyle for this solution, found it here:
'http://stackoverflow.com/questions/17551238/vba-how-to-save-excel-workbook-to-desktop-regardless-of-user
    sFilePath = "C:\temp\Match\JPG\" & ActiveSheet.Name & ".jpg"

'Export print area as correctly scaled PNG image, courtasy of Winand
    zoom_coef = 100 / Sheet.Parent.Windows(1).Zoom
    Set area = Sheet.Range(Sheet.PageSetup.PrintArea)
    area.CopyPicture xlPrinter
    Set chartobj = Sheet.ChartObjects.Add(0, 0, area.Width * zoom_coef, area.Height * zoom_coef)
    chartobj.Chart.Paste
    chartobj.Chart.Export sFilePath, "jpg"
    chartobj.Delete

'Returns to the previous view
    ActiveWindow.View = sView

'Re-enables screen updating
    Application.ScreenUpdating = True

i = i + 1
Loop

End Sub

When I step through the code it works as intended, however if I run the code from a button click or shortcut the resultant images are whitespace.

I am using Excel 2016, on a Windows 7 machine. I thought perhaps the code runs "too quickly" for the capture of the JPEG and put in small "Sleep" points, but that did not work.

Are there alternatives to this code that I may have missed?

You're not disabling screen updating. What do you mean by "step through the code"? Executing it with F5 or stepping in by F8? — , Nov 08 '17 at 07:54
See https://stackoverflow.com/questions/42091390/vba-range-to-jpg-picture/42092375#42092375: `chartobj.Activate` before `.Paste` and `.Export`. — Axel Richter, Nov 08 '17 at 08:16
By step through I mean using F8, if I press F5 the resultant JPGs are whitespace. — Keagan Allan, Nov 08 '17 at 08:43

score 0 · Accepted Answer · answered Nov 08 '17 at 09:01

Using the recommendation from Axel Richter the code now runs. I added the ChartObj.Activate before the .Paste and .Export

Question has been answered. Full Code Below in case anyone needs it.

Sub ExportImage()

'Place all worksheets in an array

Dim ShtNames() As String
ReDim ShtNames(1 To ActiveWorkbook.Sheets.Count)
For i = 1 To Sheets.Count
ShtNames(i) = Sheets(i).Name
Next i

Dim sFilePath As String
Dim sView As String

Dim WS As Worksheet, PntRng As Range, OffSetRw As Integer, OffSetClmn As Integer

i = 1

'step through each worksheet to export to JPG

Do Until i = Sheets.Count + 1
    Sheets(Sheets(i).Name).Activate

    Sheets(Sheets(i).Name).UsedRange.Select
    ActiveSheet.PageSetup.PrintArea = Selection.Address

'Credit to Winand and Ryan from this link https://stackoverflow.com/questions/16143877/using-vba-code-how-to-export-excel-worksheets-as-image-in-excel-2003/28541252

'Captures current window view
    sView = ActiveWindow.View

'Sets the current view to normal so there are no "Page X" overlays on the image
    ActiveWindow.View = xlNormalView

'Temporarily disable screen updating
    Application.ScreenUpdating = False

    Set Sheet = ActiveSheet

'Set the file path to export the image to the user's desktop
'I have to give credit to Kyle for this solution, found it here:
'http://stackoverflow.com/questions/17551238/vba-how-to-save-excel-workbook-to-desktop-regardless-of-user
    sFilePath = "C:\temp\Match\JPG\" & ActiveSheet.Name & ".jpg"
    Dim ChartObj As ChartObject
'Export print area as correctly scaled PNG image, courtasy of Winand
    zoom_coef = 100 / Sheet.Parent.Windows(1).Zoom
    Set area = Sheet.Range(Sheet.PageSetup.PrintArea)
    area.CopyPicture xlPrinter
    Set ChartObj = Sheet.ChartObjects.Add(0, 0, area.Width * zoom_coef, area.Height * zoom_coef)
    ChartObj.Activate
    ChartObj.Chart.Paste
    ChartObj.Chart.Export sFilePath, "jpg"
    ChartObj.Delete

'Returns to the previous view
    ActiveWindow.View = sView

'Re-enables screen updating
    Application.ScreenUpdating = True

i = i + 1
Loop

End Sub

FWIW, you'll probably get a nicer rendering of the text in a smaller image file if you use PNG instead of JPG. — Jon Peltier, Nov 16 '17 at 02:11
Thank you @JonPeltier. I was thinking about trying different formats in the export. I need to determine the format the destination file can accept. — Keagan Allan, Nov 16 '17 at 07:17

Exporting data and charts from Excel Worksheets to JPG

1 Answers1