Export pictures from excel file into jpg using VBA

If i remember correctly, you need to use the "Shapes" property of your sheet.

Each Shape object has a TopLeftCell and BottomRightCell attributes that tell you the position of the image.

Here's a piece of code i used a while ago, roughly adapted to your needs. I don't remember the specifics about all those ChartObjects and whatnot, but here it is:

For Each oShape In ActiveSheet.Shapes    strImageName = ActiveSheet.Cells(oShape.TopLeftCell.Row, 1).Value    oShape.Select    'Picture format initialization    Selection.ShapeRange.PictureFormat.Contrast = 0.5: Selection.ShapeRange.PictureFormat.Brightness = 0.5: Selection.ShapeRange.PictureFormat.ColorType = msoPictureAutomatic: Selection.ShapeRange.PictureFormat.TransparentBackground = msoFalse: Selection.ShapeRange.Fill.Visible = msoFalse: Selection.ShapeRange.Line.Visible = msoFalse: Selection.ShapeRange.Rotation = 0#: Selection.ShapeRange.PictureFormat.CropLeft = 0#: Selection.ShapeRange.PictureFormat.CropRight = 0#: Selection.ShapeRange.PictureFormat.CropTop = 0#: Selection.ShapeRange.PictureFormat.CropBottom = 0#: Selection.ShapeRange.ScaleHeight 1#, msoTrue, msoScaleFromTopLeft: Selection.ShapeRange.ScaleWidth 1#, msoTrue, msoScaleFromTopLeft    '/Picture format initialization    Application.Selection.CopyPicture    Set oDia = ActiveSheet.ChartObjects.Add(0, 0, oShape.Width, oShape.Height)    Set oChartArea = oDia.Chart    oDia.Activate    With oChartArea        .ChartArea.Select        .Paste        .Export ("H:\Webshop_Zpider\Strukturbildene\" & strImageName & ".jpg")    End With    oDia.Delete 'oChartArea.DeleteNext

This code:

Option ExplicitSub ExportMyPicture()     Dim MyChart As String, MyPicture As String     Dim PicWidth As Long, PicHeight As Long     Application.ScreenUpdating = False     On Error GoTo Finish     MyPicture = Selection.Name     With Selection           PicHeight = .ShapeRange.Height           PicWidth = .ShapeRange.Width     End With     Charts.Add     ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1"     Selection.Border.LineStyle = 0     MyChart = Selection.Name & " " & Split(ActiveChart.Name, " ")(2)     With ActiveSheet           With .Shapes(MyChart)                 .Width = PicWidth                 .Height = PicHeight           End With           .Shapes(MyPicture).Copy           With ActiveChart                 .ChartArea.Select                 .Paste           End With           .ChartObjects(1).Chart.Export Filename:="MyPic.jpg", FilterName:="jpg"           .Shapes(MyChart).Cut     End With     Application.ScreenUpdating = True     Exit SubFinish:     MsgBox "You must select a picture"End Sub

was copied directly from here, and works beautifully for the cases I tested.

''' Set Range you want to export to the folder

Workbooks("your workbook name").Sheets("yoursheet name").Select

Dim rgExp As Range: Set rgExp = Range("A1:H31")''' Copy range as picture onto ClipboardrgExp.CopyPicture Appearance:=xlScreen, Format:=xlBitmap''' Create an empty chart with exact size of range copiedWith ActiveSheet.ChartObjects.Add(Left:=rgExp.Left, Top:=rgExp.Top, _Width:=rgExp.Width, Height:=rgExp.Height).Name = "ChartVolumeMetricsDevEXPORT".ActivateEnd With''' Paste into chart area, export to file, delete chart.ActiveChart.PasteActiveSheet.ChartObjects("ChartVolumeMetricsDevEXPORT").Chart.Export "C:\ExportmyChart.jpg"ActiveSheet.ChartObjects("ChartVolumeMetricsDevEXPORT").Delete