Aller au contenu

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


Curlygoth

Messages recommandés

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

 

 

Lien vers le commentaire
Partager sur d’autres sites

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

 

Lien vers le commentaire
Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité