Sub extraire_img()
Dim sh As Shape, img As Object
Dim ndf As String
For Each sh In ActiveSheet.Shapes
If Left(sh.Name, 1) <> "B" Then
ActiveCell.Activate
ndf = Range(sh.TopLeftCell.Address).Offset(0, 1).Text
ndf = ActiveWorkbook.Path & "\" & ndf & ".jpg"
sh.CopyPicture xlScreen, xlPicture
Set img = ActiveSheet.ChartObjects.Add(0, 0, 5 * sh.Width, 5 * sh.Height)
Do
img.Chart.Paste
DoEvents
Loop While TypeName(Selection) = "Range" 'en attente de création de la Shape
img.Chart.Export ndf, "JPG"
img.Delete
End If
Next sh
End Sub