XL 2016 Export d'images + renommer celles-ci !

[fougeron]

Bonjour à tous,

Je suis novice en Excel et j'essaie de trouver mon bonheur pour réussir à trouver une solution à mon problème. J'ai un fichier avec en colonne A des noms et en colonne B des images (photos) qui correspondent aux noms de la colonne A. J'essaie de faire un export des images qui seraient nommées par le nom qui correspond à chaque image en colonne A.

J'ai trouvé des macros sur ce forum qui arrivent à me faire un export et à renommer mais chaque images est vierge (blanche) ! Donc, ça ne fonctionne pas. En cherchant sur internet j'ai trouvé cette macro !

Sub ExtractionImagesFeuille()
Dim Pict As Picture
Dim Nb As Byte
Dim ChartObj As ChartObject

For Each Pict In ActiveSheet.Pictures
Pict.CopyPicture 'copie l'image
Set ChartObj = ActiveSheet.ChartObjects.Add(0, 0, Pict.Width, Pict.Height)
ChartObj.Activate
ChartObj.Chart.Paste 'colle l'image dans un graphique temporaire
ChartObj.Chart.Export "C:\Users\m.fougeron\downloads\" & Pict.Name & ".jpg", "jpg" 'Sauvegarde au format image, dans le même répertoire que ce classeur.
Nb = ActiveSheet.ChartObjects.Count
ActiveSheet.ChartObjects(Nb).Delete 'Supprime le graphique
Next Pict

End Sub

Elle fonctionne parfaitement ! Elle me fait un export des photos. Par contre j'ai de modifier ça pour que cette Macro me renomme les photos avec les noms de la colonne A mais je n'y arrive pas... Je commence à désespérer !

De plus, cette macro exporte les photos par rapport à leurs tailles dans le fichier excel ! est-il possible d'avoir un export à la taille réelle de l'image avant l'intégration dans excel ?

Je vous joins un exemple en pièce jointe ! La macro est déjà intégrée dedans.

Si à tout hasard l'un de vous peut m'expliquer comment faire, ce serait top.

Merci à vous d'avoir pris le temps de me lire.

 

[Staple1600]

Bonjour le fil, fougeron

fougeron
Essaies avec cette modification

Sub ExtractionImagesFeuille()
    Dim Pict As Picture
    Dim Nb As Byte
    Dim ChartObj As ChartObject
    For Each Pict In ActiveSheet.Pictures
        Pict.CopyPicture 'copie l'image
            Set ChartObj = ActiveSheet.ChartObjects.Add(0, 0, Pict.Width, Pict.Height)
            ChartObj.Activate
            ChartObj.Chart.Paste 'colle l'image dans un graphique temporaire
            ChartObj.Chart.Export "C:\Users\m.fougeron\downloads\" & Pict.TopLeftCell.Offset(, -1) & ".jpg", "jpg" 'Sauvegarde au format image, dans le même répertoire que ce classeur.
        Nb = ActiveSheet.ChartObjects.Count
        ActiveSheet.ChartObjects(Nb).Delete 'Supprime le graphique
    Next Pict
End Sub

NB: Reste à traiter le cas des éventuels caractères interdits dans le nom des images et/ou les cellules vides.

 

[fougeron]

Bonjour le fil, fougeron

fougeron
Essaies avec cette modification

Sub ExtractionImagesFeuille()
    Dim Pict As Picture
    Dim Nb As Byte
    Dim ChartObj As ChartObject
    For Each Pict In ActiveSheet.Pictures
        Pict.CopyPicture 'copie l'image
            Set ChartObj = ActiveSheet.ChartObjects.Add(0, 0, Pict.Width, Pict.Height)
            ChartObj.Activate
            ChartObj.Chart.Paste 'colle l'image dans un graphique temporaire
            ChartObj.Chart.Export "C:\Users\m.fougeron\downloads\" & Pict.TopLeftCell.Offset(, -1) & ".jpg", "jpg" 'Sauvegarde au format image, dans le même répertoire que ce classeur.
        Nb = ActiveSheet.ChartObjects.Count
        ActiveSheet.ChartObjects(Nb).Delete 'Supprime le graphique
    Next Pict
End Sub

NB: Reste à traiter le cas des éventuels caractères interdits dans le nom des images et/ou les cellules vides.

Roh... Incredible ! C'est parfait ! incroyable ! merci beaucoup beaucoup ! ça va bien m'aider ça ! puis-je me permettre une dernière question ? si je veux que mes images soient plus grandes à l'export, dois-je impérativement les agrandir dans le document excel où bien la macro est capable de le faire pour moi en retouchant quelque chose ? D'avance merci.

 

[Staple1600]

Re

Non, ce n'est pas parfait
Par exemple, en A1 saisis ceci
Abbey<>Road?
et efface le contenu de B1
puis relances la macro, et tu verras ce que je voulais dire

Pour le reste, je t'encourage (si tu ne l'as pas encore fait) à consulter les archives du forum.
Tu y trouveras sans doute de quoi t'aider.

 

[fougeron]

Re

Non, ce n'est pas parfait
Par exemple, en A1 saisis ceci
Abbey<>Road?
et efface le contenu de B1
puis relances la macro, et tu verras ce que je voulais dire

Pour le reste, je t'encourage (si tu ne l'as pas encore fait) à consulter les archives du forum.
Tu y trouveras sans doute de quoi t'aider.

Ah oui effectivement !!! il n'exporte pas les caractères spéciaux ! sincèrement, je vais m'en contenter ! merci beaucoup ! je vais chercher dans le forum pour cette histoire de taille d'image. Merci encore à toi.

 

[fougeron]

Bonjour le fil, fougeron

fougeron
Essaies avec cette modification

Sub ExtractionImagesFeuille()
    Dim Pict As Picture
    Dim Nb As Byte
    Dim ChartObj As ChartObject
    For Each Pict In ActiveSheet.Pictures
        Pict.CopyPicture 'copie l'image
            Set ChartObj = ActiveSheet.ChartObjects.Add(0, 0, Pict.Width, Pict.Height)
            ChartObj.Activate
            ChartObj.Chart.Paste 'colle l'image dans un graphique temporaire
            ChartObj.Chart.Export "C:\Users\m.fougeron\downloads\" & Pict.TopLeftCell.Offset(, -1) & ".jpg", "jpg" 'Sauvegarde au format image, dans le même répertoire que ce classeur.
        Nb = ActiveSheet.ChartObjects.Count
        ActiveSheet.ChartObjects(Nb).Delete 'Supprime le graphique
    Next Pict
End Sub

NB: Reste à traiter le cas des éventuels caractères interdits dans le nom des images et/ou les cellules vides.

Oh bah mince... Avec mon fichier def, j'ai une erreur 1004 il m'exporte 87 fichiers sur les 1938 existants ! Pourtant, je n'ai aucun caractère spécial (ce sont des noms et prénoms).

 

[Staple1600]

Re

Les noms sont bien en colonne A?
Quelle est l'adresse de la dernière cellule non vide de la colonne A?

 

[fougeron]

Re

Les noms sont bien en colonne A?
Quelle est l'adresse de la dernière cellule non vide de la colonne A?

Oui oui, tous les noms sont en colonne A ! la dernière ligne de nom en A est A1938 (c'est ça que l'on appelle une adresse ?)

 

[Staple1600]

Re

Essaies sur une copie de ton classeur où tu ne laisses que des noms et prénoms que jusqu'en A88
(et donc supprimes également les images suivantes)
Il ne doit rester que les images correspondantes aux cellules A1:A88
Puis relances la macro (ta copie du classeur sera enregistrée dans un dossier vide)
Est-ce que le message d'erreur se produit?

 

[fougeron]

Re

Essaies sur une copie de ton classeur où tu ne laisses que des noms et prénoms que jusqu'en A88
(et donc supprimes également les images suivantes)
Il ne doit rester que les images correspondantes aux cellules A1:A88
Puis relances la macro (ta copie du classeur sera enregistrée dans un dossier vide)
Est-ce que le message d'erreur se produit?

Alors je n'ai pas de message d'erreur mais j'ai un export de 39 photos sur les 88 existantes ! c'est très très bizarre !

 

[fougeron]

Alors je n'ai pas de message d'erreur mais j'ai un export de 39 photos sur les 88 existantes ! c'est très très bizarre !

Je me demande si certaines photos ne sont pas en format "PNG" car je viens de faire un test en retirant les noms et en marquant à la place Test 1, Test 2, Test 3, etc... Et après l'export ! je n'ai pas les photos de Test 1 à Test 22, puis de Test 24 à Test 34... et ensuite quelques photos manquantes !!! très bizarre.

Mais j'ai toujours 39 photos sur les 88 du tableau Test.

 

[Staple1600]

Re

Alors continuons les investigations
Lances ces deux macros

Sub testImages1()
 Dim Pict As Picture, NomIMG As String
    For Each Pict In ActiveSheet.Pictures
    NomIMG = Pict.TopLeftCell.Offset(, -1)
    Range(Pict.BottomRightCell.Offset(, 1).Address) = NomIMG
    Next Pict
End Sub
Sub testImages2()
MsgBox ActiveSheet.Pictures.Count
End Sub

A TESTER sur une copie
1) Avec la macro 1, tu dois avoir une valeur pour chaque image qui sera inscrite en colonne C.
Est-ce bien le cas? Il n'y aucune cellule vide après l’exécution de la macro?

2) La macro 2 te donne le nombre d'images présentes sur ta feuille.
Qu'affiche la MsgBox ?

 

[fougeron]

Re

Alors continuons les investigations
Lances ces deux macros

Sub testImages1()
Dim Pict As Picture, NomIMG As String
    For Each Pict In ActiveSheet.Pictures
    NomIMG = Pict.TopLeftCell.Offset(, -1)
    Range(Pict.BottomRightCell.Offset(, 1).Address) = NomIMG
    Next Pict
End Sub
Sub testImages2()
MsgBox ActiveSheet.Pictures.Count
End Sub

A TESTER sur une copie
1) Avec la macro 1, tu dois avoir une valeur pour chaque image qui sera inscrite en colonne C.
Est-ce bien le cas? Il n'y aucune cellule vide après l’exécution de la macro?

2) La macro 2 te donne le nombre d'images présentes sur ta feuille.
Qu'affiche la MsgBox ?

Après test de la première macro, je n'ai aucune valeur en colonne C. La seconde Macro elle me dit que j'ai 91 Images.

 

[fougeron]

Après test de la première macro, je n'ai aucune valeur en colonne C. La seconde Macro elle me dit que j'ai 91 Images.

Donc si ça se trouve, j'ai des images superposées ce qui pose problème pour nommer les photos lors de l'export... Et si en plus dans tout ça il y a des ;png... alors là... Où va le monde ! On peut définitivement dire que je ne suis pas soigneux.

 

[Staple1600]

Re

Je suis parti du principe, que ton classeur original est structuré comme ton fichier exemple
(Les noms/prénoms en colonne A et les images en colonne B)
Testes sur le fichier que tu as posté ici
Tu verras que la macro 1 remplis bien la colonne C et que la seconde affiche 3.