Excel range save as image

[ali zaib]

Kindly support to guide about can save excel specific cells as image to a folder .

 

[NdNoviceHlp]

https://www.mrexcel.com/forum/excel...en-shot-given-range-every-worksheet-file.html
HTH. Dave

 

[Logit]

.
Save as .JPG

Option Explicit


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 ("C:\Users\My\Desktop\TestImage.Jpeg")
    
End Sub

Save as .GIF

Option Explicit


Sub Save_Range_As_GIF()
    Dim MyChart As Chart
    Dim objPict As Object
    Dim RgCopy As Range
    
    Range("B2:G24").CopyPicture Appearance:=xlScreen, Format:=xlBitmap
    ActiveSheet.PasteSpecial Format:="Bitmap"
    Set objPict = Selection
        
    objPict.CopyPicture 1, 1
    Set MyChart = ActiveSheet.ChartObjects.Add(1, 1, objPict.Width + 10, objPict.Height + 10).Chart
    
    With MyChart
        .Paste
        .Export ThisWorkbook.Path & Application.PathSeparator & "Temp.gif"
        .Parent.Delete
    End With
    
    MsgBox ThisWorkbook.Path & Application.PathSeparator & "Temp.gif" & " is created !"
    
    objPict.Delete
    Set objPict = Nothing
End Sub

 

[ali zaib]

Thanks for your support
Actually i want to save as image to a range instead of chart kindly support

 

[Logit]

.
Here is another macro that save a specified range as a .JPG file to the same location as the workbook.

Option Explicit


Sub Export()


 Dim oWs As Worksheet
 Dim oRng As Range
 Dim oChrtO As ChartObject
 Dim lWidth As Long, lHeight As Long


 Set oWs = ActiveSheet
 Set oRng = oWs.Range("A1:H16")


 oRng.CopyPicture xlScreen, xlPicture
 lWidth = oRng.Width
 lHeight = oRng.Height


 Set oChrtO = oWs.ChartObjects.Add(Left:=0, Top:=0, Width:=lWidth, Height:=lHeight)


 oChrtO.Activate
 With oChrtO.Chart
  .Paste
  .Export Filename:="Case.jpg", Filtername:="JPG"
 End With


 oChrtO.Delete


End Sub

Run the macro then check the saved image properties. You will see that it is a .JPG image and not a chart.

Also, the previous two macros create and image, not a chart. Check the properties of the saved images.

 

[ali zaib]

Thanks dear its working well
Again thanks for your guidelines

 

[Logit]

.
You are welcome.

 

[jolivanes]

Another possibility by John Walkenbach.
Save it as whatever strikes your fancy.

http://spreadsheetpage.com/index.php/tip/saving_a_range_as_a_graphic_file/