Need code to save a picture of a range to a jpg file. I did look on-line but I struck out.

[OaklandJim]

I've spent some time looking for this. I thought it would be easy to find. BUT I was unable to find what I need. If nothing else most examples are for a chart. I want to save a range as a jpg, not a chart.

Here is some hacky code that makes a picture of a range but I cannot figure out how to save that picture as a file.

Sub Macro3()
'
        Dim sFolder As String
        
        Dim sPictureName As String
        
        sFolder = "C:\Users\Jim\Desktop\"
        
        sPictureName = "TableRange"
        
        Range("B14:D20").Copy
        
        ActiveSheet.Pictures.Paste.Select
        
        With Selection
            .ShapeRange.Name = "TablePicture"
            .Name = "TablePicture"
            
'           Object does not support this property or method
            '.SaveAs Filename:=sFolder & sFolder & ".jpg"
            '.Shapes.SaveAs Filename:=sFolder & sPictureName & ".jpg"
            '.Shapes.Export Environ("USERPROFILE") & "\Desktop\" & sPictureName & ".jpg"
            '.Export Filename:=Environ("USERPROFILE") & "\Desktop\" & sPictureName & ".jpg", Filtername:="JPG"

            '.Cut
        End With
        
'       Object does not support this property or method
        'ActiveSheet.ShapeRange(sPictureName).Export Environ("USERPROFILE") & "\Desktop\" & sPictureName & ".jpg"

'       Shape not found...but it exists?
        'ActiveSheet.Shapes(sPictureName).Export Environ("USERPROFILE") & "\Desktop\" & sPictureName & ".jpg"
        
        Application.CutCopyMode = False

End Sub

 

[Micron]

I have not tried this before now, but the code I've read elsewhere says you have to use the Chart object. That does not mean you're ending up with a chart. You remove the chart object fill and borders and are supposed to end up with a pic of your range. I tested the jpg code here and it worked for me

VBA Code To Save As Picture in Excel

Learn how you can creatively utilize chart objects as a workaround to VBA’s lack of functionality to save shapes, icons, and ranges as image files.

www.thespreadsheetguru.com

but note that step 6 of the explanation for that code mis-identifies the pic as a png when it's not. Also, I encountered an error at the very end but that should be easily avoidable.

 

[OaklandJim]

Thanks for that. I realy appreciate your assistance!

I am trying to adapt that code for my need. I tried feeding a shape object into the adapted code (below) but I get a type mismatch error.

In caller sub I have this code

        rTableRange.Copy
        
        ActiveSheet.Pictures.Paste.Select
        
        Call SavePictureToFile(Selection)

The adaptation of the code you suggested is

Sub SavePictureToFile(shpPictureToSave As Shape)
'PURPOSE: Save specified shape as a JPG file to computer's desktop
'SOURCE: www.thespreadsheetguru.com

    Dim cht As ChartObject

'   Create a temporary chart object (same size as shape)
    Set cht = ActiveSheet.ChartObjects.Add( _
    Left:=ActiveCell.Left, _
    Width:=shpPictureToSave.Width, _
    Top:=ActiveCell.Top, _
    Height:=shpPictureToSave.Height)

'Format temporary chart to have a transparent background
    cht.ShapeRange.Fill.Visible = msoFalse
    cht.ShapeRange.Line.Visible = msoFalse
    
'Copy/Paste Shape inside temporary chart
    shpPictureToSave.Copy
    cht.Activate
    ActiveChart.Paste
   
'Save chart to User's Desktop as PNG File
    cht.Chart.Export Environ("USERPROFILE") & "\Desktop\" & "TestPic" & ".jpg"

'Delete temporary Chart
    cht.Delete

End Sub

If I declare the parameter as a picture the code executes. Unfortunately, the picture exported has the correct # of rows and columns but there is no data included.

 

[OaklandJim]

So a really lame move. The picture that I'm feeding into the sub is of a range that is empty.

 

[Micron]

Rather than attempting to send a shape object (which actually looks to me like it is a picture object) to a sub why don't you start with something closer to what is at that website? This works for me if a range on the sheet is pre-selected.

Sub SaveRangeAsPicture()
'PURPOSE: Save a selected cell range as a JPG file to computer's desktop
'SOURCE: www.thespreadsheetguru.com

Dim cht As ChartObject
Dim ActiveShape As Shape

'Confirm if a Cell Range is currently selected
  If TypeName(Selection) <> "Range" Then
    MsgBox "You do not have a single shape selected!"
    Exit Sub
  End If
Application.EnableEvents = False '<<added by me to prevent other code from running
'Copy/Paste Cell Range as a Picture
  Selection.Copy
  ActiveSheet.Pictures.Paste(Link:=False).Select
  Set ActiveShape = ActiveSheet.Shapes(ActiveWindow.Selection.Name)
  
'Create a temporary chart object (same size as shape)
  Set cht = ActiveSheet.ChartObjects.Add( _
    Left:=ActiveCell.Left, _
    Width:=ActiveShape.Width, _
    Top:=ActiveCell.Top, _
    Height:=ActiveShape.Height)

'Format temporary chart to have a transparent background
  cht.ShapeRange.Fill.Visible = msoFalse
  cht.ShapeRange.Line.Visible = msoFalse
    
'Copy/Paste Shape inside temporary chart
  ActiveShape.Copy
  cht.Activate
  ActiveChart.Paste
   
'Save chart to User's Desktop as PNG File
  ''cht.Chart.Export Environ("USERPROFILE") & "\Desktop\" & ActiveShape.Name & ".jpg"
  cht.Chart.Export "C:\Users\Micron\Pictures\CodeTest.jpg"
'Delete temporary Chart
  cht.Delete
  ActiveShape.Delete

Application.EnableEvents = True
'Re-Select Shape (appears like nothing happened!)
  ''ActiveShape.Select '<<this raises an error for me. I don't see the point in trying to select a shape that has already been deleted so I commented out.

End Sub

I advocate using an error handler if altering application level properties, but I have not done that here even though I'm cycling EnableEvents.
NOTE - if you're still getting an error after what you last posted, then run your sub. When it goes into break mode, type this in the immediate window and hit return and see what it is you're passing to the sub.
?typeName(selection)

 

[OaklandJim]

Thanks to your assistance I have what I need. The sub I created -- based on what you showed me -- required that I specify the parameter as a Picture not a Shape. I'll add the events disable/enable code as you suggest.

Sub SavePictureToFile(shpPictureToSave As Picture)
'PURPOSE: Save specified shape as a JPG file to computer's desktop
'SOURCE: www.thespreadsheetguru.com

    Dim cht As ChartObject

'   Create a temporary chart object (same size as shape)
    Set cht = ActiveSheet.ChartObjects.Add( _
    Left:=ActiveCell.Left, _
    Width:=shpPictureToSave.Width, _
    Top:=ActiveCell.Top, _
    Height:=shpPictureToSave.Height)

'   Format temporary chart to have a transparent background
    cht.ShapeRange.Fill.Visible = msoFalse
    cht.ShapeRange.Line.Visible = msoFalse
    
'   Copy/Paste Shape inside temporary chart
    shpPictureToSave.Copy
    cht.Activate
    ActiveChart.Paste
   
'   Save chart to User's Desktop as PNG File
    cht.Chart.Export Environ("USERPROFILE") & "\Desktop\" & "TestPic" & ".jpg"

'   Delete temporary Chart
    cht.Delete

End Sub

 

[Micron]

Glad I could help & thanks for the recognition.