Aller au contenu

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


Curlygoth
 Partager

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

Rejoindre la conversation

Vous pouvez publier maintenant et vous inscrire plus tard. Si vous avez un compte, connectez-vous maintenant pour publier avec votre compte.

Invité
Répondre à ce sujet…

×   Collé en tant que texte enrichi.   Coller en tant que texte brut à la place

  Seulement 75 émoticônes maximum sont autorisées.

×   Votre lien a été automatiquement intégré.   Afficher plutôt comme un lien

×   Votre contenu précédent a été rétabli.   Vider l’éditeur

×   Vous ne pouvez pas directement coller des images. Envoyez-les depuis votre ordinateur ou insérez-les depuis une URL.

 Partager

×
×
  • 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é