asked on

Excel - Saving a range as a jpeg

Good Afternoon.

I would like some help with a script that takes a range of cells in excel and saves the range as a JPEG image on a local drive.

Then I would like this to cast this image on a TV. So any ideas on what is the best solution to use.. Thinking of a dashboard

Thanks

Roy Cox

Try this

Option Explicit

Sub RangeToJpeg()
    Dim iX As Integer, iCnt As Integer
    Dim oPic As Shape
    Dim oChart As Chart
    
        ''///copy the range as an image
    Call Selection.CopyPicture(xlScreen, xlPicture)

    ''///remove all previous shapes in sheet2
    iCnt = Sheet2.Shapes.Count
    For iX = 1 To iCnt
        Sheet2.Shapes.Item(1).Delete
    Next iX
    ''///create an empty chart in sheet2
    Sheet2.Shapes.AddChart
    ''///activate sheet2
    Sheet2.Activate
    ''///select the shape in sheet2
    Sheet2.Shapes.Item(1).Select
    Set oChart = ActiveChart
    ''///paste the range into the chart
    oChart.Paste
    ''///save the chart as a JPEG
    oChart.Export (("C:\Users\My\Desktop\Test.jpeg"))
End Sub

Open in new window

Rob Henson

You can use the Camera tool to create an image from a particular range.

Is the range fixed or will be variable?

Roy Cox

Excel also has the Copy as Picture option in the ClipBoard Group of the Home Tab of the Ribbon. This basically uses the Camera, but I think it is limited to a bmp which would require converting.

NICK COLLINS

ASKER

Thanks for your comments..

The range will be fixed as follows 'A1:D15'

NICK COLLINS

ASKER

On a Worksheet called 'Summary'

ASKER CERTIFIED SOLUTION

Roy Cox

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

NICK COLLINS

ASKER

Thank You - It works perfectly

NICK COLLINS

ASKER

Just a thought..

If I had a title in cell F1 - is there a way I could save the image as the contents in Cell F1 automatically..

Roy Cox

I'm not sure what you mean

NICK COLLINS

ASKER

instead of saving the image as test.jpeg, could it be saved as a value in a particular cell. so if the value in cell F1 was September, the image would be saved as September.jpeg

Roy Cox

Amend this line

oChart.Export (("C:\Users\name here\Desktop\Test.jpeg"))

Open in new window

   oChart.Export (("C:\Users\name here\Desktop\" & Sheets("Summary").Range("F1").Value & ".jpeg"))

Open in new window

NICK COLLINS

ASKER

That's worked perfect with renaming..

Just one issue with the JPEG it is quite small and not very clear..

The range on the spreadsheet is set to a page of A4.. do you have any advice on how to enlarge the jpeg to the size of A4?

Roy Cox

See if this improves the image quality

Option Explicit

Sub RangeToJpeg()
    Dim TempSht As Worksheet
    Dim rRng As Range
    Dim iX As Integer, iCnt As Integer
    Dim oPic As Shape
    Dim oChart As Chart

    Set rRng = Sheets("Summary").Range("A1:D15")

    ''///copy the range as an image
    Call rRng.CopyPicture(xlScreen, xlPicture)
    On Error GoTo exit_err
    With Application
        .ScreenUpdating = False
        Set TempSht = Worksheets.Add
        ''///create an empty chart in sheet2
        TempSht.Shapes.AddChart
        ''///select the shape in sheet2
        TempSht.Shapes.Item(1).Select
        Set oChart = ActiveChart
        With TempSht
            .Shapes.Item(1).Width = rRng.Width
            .Shapes.Item(1).Height = rRng.Height
            ''///paste the range into the chart
            oChart.Paste
            ''///This makes the pasted image larger before exporting and will hopefully improve quality. _
                 you can try changing 3 but don't increase too much
            .Shapes.Item(1).ScaleWidth 3, msoFalse, msoScaleFromTopLeft
        End With
        ''///save the chart as a JPEG
        ''/// edit the next line
        oChart.Export ("C:\Users\name here\Desktop\Test.jpeg")
        .DisplayAlerts = False
        TempSht.Delete
        .DisplayAlerts = True
exit_err:
        .ScreenUpdating = True
    End With
End Sub

Open in new window

NICK COLLINS

ASKER

No PDF would be a suitable replacement