Sub SaveRangeAsPicture()
    'Save cell range as a JPG - www.thespreadsheetguru.com
    Dim cht As ChartObject
    Dim ActiveShape As Shape
    
    Range("D7:I32").Select
    Selection.Copy
    ActiveSheet.Pictures.Paste(link:=False).Select
    Set ActiveShape = ActiveSheet.Shapes(ActiveWindow.Selection.Name)
    Set cht = ActiveSheet.ChartObjects.Add(Left:=ActiveCell.Left, Width:=ActiveShape.Width, Top:=ActiveCell.Top, Height:=ActiveShape.Height)
    cht.ShapeRange.Fill.Visible = msoFalse
    cht.ShapeRange.Line.Visible = msoFalse
    ActiveShape.Copy
    cht.Activate
    ActiveChart.Paste
    cht.Chart.Export "C:\temp\shape.jpg"
    cht.Delete
    ActiveShape.Delete
End Sub