Share

Excel VBA, Save Range/Cells as JPEG

In this article I will explain how you can use VBA for Excel to save a range of cells as a JPEG image. Basically what we do is the following:

  1. Create an empty chart in some sheet which is not used.
  2. Copy the cells with the required data as a picture.
  3. Paste the range onto the chart.
  4. Export the table.

 


Save Range as JPEG:

In this example I will save the range A1:E12 as a JPEG image to the path “D:StuffBusinessTemp”

Excel, VBA, Data to Save as JPEG
This can be done using the code below:

Sub Example1()
Dim i As Integer
Dim intCount As Integer
Dim objPic As Shape
Dim objChart As Chart
'copy the range as an image
Call Sheet1.Range("A1:E12").CopyPicture(xlScreen, xlPicture)

'remove all previous shapes in sheet2
intCount = Sheet2.Shapes.Count
For i = 1 To intCount
Sheet2.Shapes.Item(1).Delete
Next i
'create an empty chart in sheet2
Sheet2.Shapes.AddChart
'activate sheet2
Sheet2.Activate
'select the shape in sheet2
Sheet2.Shapes.Item(1).Select
Set objChart = ActiveChart
'paste the range into the chart
objChart.Paste
'save the chart as a JPEG
objChart.Export ("D:StuffBusinessTempExample.Jpeg")
End Sub

Result:

Example
The line below copies the range as an image:

Call Sheet1.Range("A1:E12").CopyPicture(xlScreen, xlPicture)

The for i loop below removes any previous shapes and charts in sheet2:

'remove all previous shapes in sheet2
intCount = Sheet2.Shapes.Count
For i = 1 To intCount
Sheet2.Shapes.Item(1).Delete
Next i

Basically this should be done on an empty sheet to make sure nothing goes wrong.

The lines below add a new chart and assign it the objChart variable:

'create an empty chart in sheet2
Sheet2.Shapes.AddChart
'activate sheet2
Sheet2.Activate
'select the shape in sheet2
Sheet2.Shapes.Item(1).Select
Set objChart = ActiveChart

The line below pastes the range as a picture onto the chart:

objChart.Paste

The line below saves the chart as a JPEG at the address “D:StuffBusinessTemp”:

objChart.Export ("D:StuffBusinessTempExample.Jpeg")


Remove White Spaces From Image:

As you can see from the resulting image in the previous section, there was a lot of empty space around the final image. The image dimensions are based on the dimensions of the chart object . In order to remove those spaces we must modify the dimensions of the chart to match those of the range. This can be done by adding the lines below to our previous code:

Sub Example2()
Dim i As Integer
Dim intCount As Integer
Dim objPic As Shape
Dim objChart As Chart
'copy the range as an image
Call Sheet1.Range("A1:E12").CopyPicture(xlScreen, xlPicture)

'remove all previous shapes in sheet2
intCount = Sheet2.Shapes.Count
For i = 1 To intCount
Sheet2.Shapes.Item(1).Delete
Next i
'create an empty chart in sheet2
Sheet2.Shapes.AddChart
'activate sheet2
Sheet2.Activate
'select the shape in sheet2
Sheet2.Shapes.Item(1).Select
Set objChart = ActiveChart
'paste the range into the chart
Sheet2.Shapes.Item(1).Width = Range("A1:E12").Width
Sheet2.Shapes.Item(1).Height = Range("A1:E12").Height
objChart.Paste
'save the chart as a JPEG
objChart.Export ("D:StuffBusinessTempExample.Jpeg")
End Sub

Result:

Example


Remove Image Border:

As you can from the images from the previous sections a black border was added to the image. This is due to the chart objects border. In order to remove the border, we would need to remove the chart objects border. This can be done by adding the line below:

Sub Example3()
Dim i As Integer
Dim intCount As Integer
Dim objPic As Shape
Dim objChart As Chart
'copy the range as an image
Call Sheet1.Range("A1:E12").CopyPicture(xlScreen, xlPicture)

'remove all previous shapes in sheet2
intCount = Sheet2.Shapes.Count
For i = 1 To intCount
Sheet2.Shapes.Item(1).Delete
Next i
'create an empty chart in sheet2
Sheet2.Shapes.AddChart
'activate sheet2
Sheet2.Activate
'select the shape in sheet2
Sheet2.Shapes.Item(1).Select
Set objChart = ActiveChart
'paste the range into the chart

Sheet2.Shapes.Item(1).Line.Visible = msoFalse
Sheet2.Shapes.Item(1).Width = Range("A1:E12").Width
Sheet2.Shapes.Item(1).Height = Range("A1:E12").Height
objChart.Paste
'save the chart as a JPEG
objChart.Export ("D:StuffBusinessTempExample.Jpeg")
End Sub

Result:

Example

You can download the file and code related to this article from the link below:

See also:

If you need assistance with your code, or you are looking for a VBA programmer to hire feel free to contact me. Also please visit my website www.software-solutions-online.com

 

15 thoughts on “Excel VBA, Save Range/Cells as JPEG”

  1. qumquatsch says:

    Very helpful, thanks ! I have one problem though: if I set line.visible = msoFalse then Excel crashes when it´s about to execute the export line. Funny thing: if I step through the code step by step (f8) it works. Any idea why ?

    1. qumquatsch says:

      I meant shift+f8

    2. qumquatsch says:

      Just found it out by myself, maybe it helps someone:

      Line.Visible = msoFalse has to be set jsut before the export, _after_ the paste. Idk why.

      1. pedrumj says:

        I see you found a solution :), let me know if you have any other questions

  2. daleranderson says:

    This is great. I have just used it to make a tool to enable quick image editing and labelling at work. I have noticed that images are ending up with an extra pixel for each dimension but I imagine that should be fixable somehow.

    Thanks for sharing your knowledge.

    Cheers, Dale

    1. pedrumj says:

      Hi there

      I’m glad you found this article useful. Feel free to contact me if you need additional assistance with your macro.

  3. Luke Macaulay says:

    Thanks so much for the post! This is really close to what I’m trying to do, but I need to tweak it a bit. I basically want to save a single cell from column N as a JPEG image, which is pretty close to what you have here. The challenge for me is that I have a list of about 500 records to do this with and I’d like to name that image based on the full path and filename text found within another cell in the A column. Here’s my attempt so far. I’m getting close but the debugger has a problem with the “Call Sheet1.Range(“N2).CopyPicture(xlScreen, xlPicture), giving me a 1004 runtime error: “CopyPicture method of range class failed.”

    Sub Save_Image()

    Dim i As Integer
    Dim intCount As Integer
    Dim objPic As Shape
    Dim objChart As Chart
    Dim cell As Range

    For Each cell In Range(“A2:N2”, Range(“N” & Rows.Count).End(xlUp))

    ‘Insert a modified version of your code here
    ‘copy the range as an image

    Call Sheet1.Range(“N2”).CopyPicture(xlScreen, xlPicture)

    ‘remove all previous shapes in sheet2
    intCount = Sheet2.Shapes.Count
    For i = 1 To intCount
    Sheet2.Shapes.Item(1).Delete
    Next i
    ‘create an empty chart in sheet2
    Sheet2.Shapes.AddChart
    ‘activate sheet2
    Sheet2.Activate
    ‘select the shape in sheet2
    Sheet2.Shapes.Item(1).Select
    Set objChart = ActiveChart
    ‘paste the range into the chart

    Sheet2.Shapes.Item(1).Line.Visible = msoFalse
    Sheet2.Shapes.Item(1).Width = Range(“N2”).Width
    Sheet2.Shapes.Item(1).Height = Range(“N2”).Height
    objChart.Paste

    ‘save the chart as a JPEG
    ‘modify this to use the text from a particular cell to inform the path- pretty sure this won’t work

    Dim fileName As String
    fileName = Range(“A2”).Text
    objChart.Export (“fileName”)

    Next cell
    End Sub

    Do you have any suggestions? Thanks so much in advance!
    Luke

    1. pedrumj says:

      Hi there

      I will have to take a look at your workbook. Please email the file you are having trouble with so I can take a look at it.

      1. Luke Macaulay says:

        Thanks so much for your help Pedrum! Your help got my macro working well!

        1. pedrumj says:

          No problem, glad I could help:)

  4. Kevin says:

    Shapes.Item(1).Delete should be Shapes.Items(i).Delete, right?

    Also, not sure why, but the .Height and .Width are misbehaving for me. Each seems to work correctly on their own, but running the second of the pair resets the first one to its original value.

    1. Kevin says:

      Nevermind on the height/width, typo on my part.

  5. robin says:

    Hi Luke, I want to do the similar print as JPEG for long list of record,, can u share how to do it with your code ?

    Thanks

  6. Adam says:

    Hi! For whatever reason, my original images are being squished when saved. They look fine when they’re pasted in the workbook, but aspect changes upon saving!

  7. Rocky says:

    This seems to not work on Mac but works on Windows. Is ther any workaround for mac ?

Leave a Reply

Your email address will not be published. Required fields are marked *