Export des images d'excel vers un dossier / Récupérer tous les médias d'un tableur

[Curlygoth]

Bonjour,

Suite à une demande par MP pour extraire toutes les images d'un classeur vers un dossier, je me disais qu'il serait bon de partager ce code :

1°) définir le dossier

2°) Boucler sur les formes des feuilles

3°) vérifier les types de formes pour ne traiter QUE les images

4°) Copier l'image l'inserer dans un objet pour les graphiques (coller l'image) et export l'objet graphique

 

Sub export_img()
Dim dossier As String
Dim monimage As String
dossier = ThisWorkbook.Path & "\"
For i_NF = 1 To Sheets.Count
    Worksheets(i_NF).Activate
    NB_IMG = Worksheets(i_NF).Shapes.Count
    For i_IMG = 1 To NB_IMG
        Worksheets(i_NF).Shapes.Item(i_IMG).Select
        Set sh = Worksheets(i_NF).Shapes.Item(i_IMG)
        If sh.Type <> 13 Then GoTo suivant:
        Call sh.CopyPicture(xlScreen, xlBitmap)
        nomimage = dossier & Worksheets(i_NF).Name & "-" & i_IMG & ".jpg"
        With Worksheets(i_NF).ChartObjects.Add(0, 0, sh.Width, sh.Height).Chart
            .Paste
            .Export nomimage, "JPG"
        End With
suivant:
    Next i_IMG
Next i_NF
End Sub

 

Edit :

Si vous souhaitez mettre les images dans des dossiers avec le nom des onglets d'ou elles proviennent :

Sub export_img()

'Parcours de toutes les feuilles
For i_NF = 1 To Sheets.Count
Worksheets(i_NF).Activate
NB_IMG = Worksheets(i_NF).Shapes.Count

    'Parcours de toutes les images
    For i_IMG = 1 To NB_IMG
    
    Worksheets(i_NF).Shapes.Item(i_IMG).Select
    
    'détection si images
    If Worksheets(i_NF).Shapes.Item(i_IMG).Type <> 13 Then GoTo suivant:
        
    Call Worksheets(i_NF).Shapes.Item(i_IMG).CopyPicture(xlScreen, xlBitmap)
    
    Set Sh = ActiveSheet.Shapes(i_IMG)
    
    dossier = ThisWorkbook.Path & "\" & Worksheets(i_NF).Name & "\"
    
    On Error Resume Next
    MkDir dossier
    On Error GoTo 0
    
    monimage = dossier & Worksheets(i_NF).Name & "-" & i_IMG & ".jpg"
    
    With ActiveSheet.ChartObjects.Add(0, 0, Sh.Width, Sh.Height).Chart
        .Paste
        'Sauvegarde l'image du graphique au format jpg
        .export monimage, "JPG"
    End With

suivant:
    Next i_IMG
Next i_NF

End Sub

 

 

[fabcad]

Bonjour,

En renommant l'extension du fichier excel en fichier ZIP et en le decompressant on peut récupérer les images situées dans un dossier média.

Cela fonctionne pour les fichiers word (docx) powerpoint (pptx).

Apres la décompression, en faisant une recherche via l'explorateur Windows des fichiers images (jpg, png, emb...) et AntRenamer pour les renommer avec le dossier parent (le nom du fichier zip) on n'a pu récupérer 120 images avec un collègue.

Fabcad Le Rennais Métropolitain

 

[Curlygoth]

Bon a savoir aussi !

[lili2006]

Bonjour à toutes et tous,

 

Merci pour l'astuce @fabcad🙂

[GEGEMATIC]

Merci à tous, et a Curly qui s'est donné du mal pour me sortir de la panade !

gégé

[La Lozère]

Merci @fabcad, ça c'est de l'info qui déchire.... Il faut la trouver celle-là 😲

[Curlygoth]

j'ai modifier le titre

c'est aussi comme ça qu'on crack les tableurs avec des mots de passe