Sub ExportImage()
répertoire = ThisWorkbook.Path
Set f = ActiveSheet
For i = 1 To ActiveSheet.Shapes.Count
Set img = f.Shapes(i)
img.CopyPicture
f.ChartObjects.Add(0, 0, img.Width, img.Height).Chart.Paste
f.ChartObjects(1).Chart.Export Filename:=répertoire & "\" & ActiveSheet.Shapes(i).Name & ".jpg", FilterName:="jpg"
f.ChartObjects(1).Delete
Next i
End Sub