Save Excel range (or shape) to picture

This is an interesting approach to export a range of cells into picture using chart object.
An article that I need to utilize to create function from it in the near future.
Originally found on theSpreadsheetguru ...
https://www.thespreadsheetguru.com/blog/vba-save-as-picture-file-excel

CodeFunctionName

What is this?

Public

Not Tested

Imported

Sub SaveShapeAsPicture()
'PURPOSE: Save a selected shape/icon as a PNG file to computer's desktop
'SOURCE: www.thespreadsheetguru.com
Dim cht As ChartObject
Dim ActiveShape As Shape
Dim UserSelection As Variant
'Ensure a Shape is selected
On Error GoTo NoShapeSelected
    Set UserSelection = ActiveWindow.Selection
    Set ActiveShape = ActiveSheet.Shapes(UserSelection.Name)
On Error GoTo 0
'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 & ".png"
'Delete temporary Chart
cht.Delete
'Re-Select Shape (appears like nothing happened!)
ActiveShape.Select
Exit Sub
'ERROR HANDLERS
NoShapeSelected:
MsgBox "You do not have a single shape selected!"
Exit Sub
End Sub

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
'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"
'Delete temporary Chart
cht.Delete
ActiveShape.Delete
'Re-Select Shape (appears like nothing happened!)
ActiveShape.Select
End Sub

Not tested yet