XL 2013 exraire des images d'un fichier excel

Sub ExtractionImagesClasseur()
Dim Pict As Picture, Nb As Byte, F As Worksheet
Application.ScreenUpdating = False
For Each F In ThisWorkbook.Worksheets
For Each Pict In F.Pictures
    Pict.CopyPicture 'copie l'image
    With F.ChartObjects.Add(0, 0, Pict.Width, Pict.Height).Chart
          .Paste 'colle l'image dans un graphique temporaire
          'Sauvegarde au format image, dans le même répertoire que ce classeur. voir choix gif/jpg/bmp !?
          '.Export ThisWorkbook.Path & "\" & Pict.Name & ".gif", "GIF"
          '.Export ThisWorkbook.Path & "\" & Pict.Name & ".jpg", "JPG"
           .Export ThisWorkbook.Path & "\" & Pict.Name & ".bmp", "BMP"
    End With
    'Supprime le graphique
    Nb = F.ChartObjects.Count: F.ChartObjects(Nb).Delete
Next Pict: Next F
Application.ScreenUpdating = True
End Sub

Sub Exporte_Shapes()
Dossier = "C:\Temp\"
For i = 1 To ActiveSheet.Shapes.Count
NomShape = ActiveSheet.Shapes(i).Name
ActiveSheet.Shapes(i).Copy
Sheets.Add
ActiveSheet.Paste
With ActiveSheet.ChartObjects.Add(0, 0, Selection.Width, Selection.Height).Chart
.Paste
.Export Dossier & NomShape & ".jpg", "JPG"
End With
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
Next
End Sub

Sub test()
Dim Sh As Shape, Ppt As Object, Pres As Object, ShPpt As Object
    Set Ppt = CreateObject("Powerpoint.Application")
    Set Pres = Ppt.presentations.Add
    Pres.slides.Add 1, 12
    For Each Sh In ActiveSheet.Shapes
        If Sh.Type = msoPicture Then
            Sh.Copy
            Set ShPpt = Pres.slides(1).Shapes.Paste
            ShPpt.Export "d:\temp\" & ShPpt.Name & ".png", 2
            ShPpt.Delete
        End If
    Next
    Pres.Saved = True
    Pres.Close
    Set Pres = Nothing
    Ppt.Quit
    Set Ppt = Nothing
End Sub

For Each F In ThisWorkbook.Worksheets
For Each Pict In F.Pictures
     If Lcase(Left(Pict.Name, 5)) = "photo" then
        'ici la suite du code
     end if
Next Pict: Next F