XL 2021 Extraction images depuis commentaire de cellule vers dossier.

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

jeff1494

XLDnaute Occasionnel
Bonjour à toutes et tous;

J'ai un fichier contenant plusieurs feuilles, dont une nommée "INVENDUS" qui contient une liste d'objets.
Une ligne par objet, et en colonne 2 j'ai la description de l'objet qui contient en commentaire une photo de l'objet.

Je voudrais par macro , pour chaque ligne pouvoir extraire la photo contenue en colonne 2, et la sauvegarder dans un dossier que je nomme "JPG_INV", avec comme nom la valeur de la cellule A de la ligne, et une extension ".jpg".

Pour ce faire j'ai récupéré une macro donnée par @patricktoulon sur un autre forum dans un message dont voici le lien (message #15).
Je l'ai placé dans un module nommé "Export_Images".

J'ai juste adapté le code pour correspondre à mes besoins, à priori rien qui ne puisse changer le fonctionnement de la macro.

Le résultat de l'exécution de cette macro, est que je crée bien les images dans le répertoire défini, mais juste la première images qui est affichée comme un carré blanc dans l'explorateur de Windows.

Donc si jamais @patricktoulon passait par là, je lui serais reconnaissant de bien vouloir m'aider à comprendre pourquoi la première image reste comme un carré blanc, alors que les suivantes sont correctement créées. Mais si une autre personne a une idée du pourquoi du comment je suis preneur.

A toutes fins utiles je vous joins un exemple du fichier que j'utilise.

D'avance je remercie tous ceux ou celles qui voudront bien perdre un peu de leur temps pour m'aider.
Bonne journée à toutes et tous.
 

Pièces jointes

Solution
Bonsoir @jeff1494

"Il manquait cela : .Activate"

Pour comprendre ici en Poste #38 : https://excel-downloads.com/threads/export-dimages-renommer-celles-ci.20034890/post-20674531

VB:
Option Explicit

Sub Export_Photos()
    Dim i As Long
    On Error Resume Next
    MkDir ThisWorkbook.Path & "\JPG_INV"
    Err.Clear
'    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets.Add(After:=Sheets("INVENDUS")).Name = "Feuille_Transit"
    
    With Sheets("Feuille_Transit").ChartObjects.Add(0, 0, 100, 100).Chart
        .Parent.Name = "calque"
    End With
    For i = 2 To Sheets("INVENDUS").Cells(Rows.Count, 2).End(xlUp).Row
        If Sheets("INVENDUS").Cells(i, 2).Comment.Shape.Fill.Type = 6 Then
        save_comment_fichier_jpg...
Alors il é bo' ou pas mon dialog
si jeff repasse par là il va péter les plombs de voir l’évolution d'un besoins a plusieurs conceptions et même un dialog maintenant
chez moi j'ai tout a par ta couronne mais me semble t il que l'on avait déjà eu un problème avec
 
Bonjour @laurent950 , @jurassic pork , @fanch55 , @jeff1494

@patricktoulon 🌟 Un immense merci à Patrick Toulon ! 🌟

Pour avoir finalisé son code avec une précision et une maîtrise impressionnantes. 🎯

C’est une véritable prouesse technique, et je suis admiratif du travail accompli. Merci pour ton aide précieuse et pour avoir partagé ton expertise avec autant de générosité. 👏

Bravo et encore merci ! 🙌

Bonjour @laurent950 , @jurassic pork , @fanch55 , @jeff1494
un petit kado'
la voici maintenant dans son propre dialog V1
1738756311847.png
 
cette ressource est une ressource en équipe
Normalement comme vous êtes inscrit dans l'équipe vous devriez pouvoir la voir même si ce n'est pas encore passé en modération
les membres de l'équipe ont le pouvoir normalement d'apporter des modifs
 
Dernière édition:
Bonjour à tous;
@patricktoulon, @jurassic pork @laurent950;

Je suis régulièrement ce fil, mais vous m'avez perdu il y a bien longtemps 😱🤣.

J'avoue que vous êtes dans un monde qui pour moi reste un inconnu total, et n'est pas loin de relever de la science fiction.
Donc je me contente de vous lire et d'essayer de comprendre ce qui pour moi est, et restera pour longtemps, du javanais, voire même pire de l'extra terrestre.

Je suis époustouflé de voir comment depuis une question qui a été réglée, somme toute assez rapidement, après quelques messages, il vous est passé par l'esprit de vous lancer dans cette recherche d'une manière frénétique, et d'arriver à un résultat qui, comment dire, représente tout ce que l'on arrive à faire quand on a des connaissance solides. On dirait que le fait d'être em..rdé par un système n'a fait que de vous motiver encore plus.

Pour une personne comme moi qui essaie de se débrouiller comme il peut avec ses faibles connaissances cela donne envie d'essayer d'en savoir plus et peut-être un jour arriver à discuter avec des gens comme vous pour avoir une motivation supplémentaire et pouvoir réaliser ce genre de choses.

Donc tout d'abord je vous félicite de tout cœur pour avoir démontré qu'à plusieurs on peut résoudre toutes sortes de problèmes, et qu'il y en a plus dans plusieurs têtes que dans une, et que si on le décide tout peut-être réalisable. Si seulement cela pouvait exister dans la vie de tous les jours !!

Pour en revenir à un autre domaine, je voudrait particulièrement remercier @patricktoulon pour les remarques qu'il m'a faites concernant l'approche des problèmes. Cela m'a permis de comprendre que je m'y prenait comme un manche (et encore je reste poli 😉), et que finalement il n'était pas si extraordinaire que cela que je n'arrive pas à structurer correctement mes idées.

Bref au travers de cet exemple, j'ai compris qu'il me reste encore beaucoup de chemin à parcourir. Mais tant qu'il y a un chemin, tout n'est pas perdu.
Un grand merci à vous trois pour ce travail magnifique. 🙌🙌👏👏
Ne me reste plus maintenant qu'a voir comment intégrer cela à mon problème, une fois que j'aurai totalement refondu mon approche.

Je vous souhaite une bonne journée à tous les trois.
 
Hello,
Excellent boulot Patrick !
J'ai planché un peu sur ce problème de wmf car c'est moi qui avait amené la couronne dans le forum avec le problème qui est ici
Dans un premier temps j'ai essayé de charger un autre wmf et cela ne fonctionnait pas et je me suis aperçu que tu chargeais le wmf avec un LoadPicture et pas avec le WIA alors j'ai fait une modif pour charger tous les types d'images avec le WIA :
VB:
'1° loader tout type d'images dans un control image dans un userform

'    If " wmf jpg " Like "* " & ListBox1.List(ListBox1.ListIndex, 3) & " *" Then
'        framevue.Image1.Picture = LoadPicture(wbk.Path & "\" & ListBox1.List(ListBox1.ListIndex, 2))
'    Else
        framevue.Image1.Picture = LoadAnyPicture(wbk.Path & "\" & ListBox1.List(ListBox1.ListIndex, 2))
'    End If

Function LoadAnyPicture(ByVal Filename As String) As StdPicture
    Dim ch$, nom$
    With CreateObject("WIA.ImageFile")
        .Loadfile Filename
        Set LoadAnyPicture = .FileData.Picture
    End With
End Function

J'ai regardé au point de vue performance , il n'y a que quelques millisecondes d'écart et encore.
Mes autres WMF fonctionnent avec ce code mais pas la couronne : j'ai un message d'erreur paramètre incorrect.
Alors j'ai utilisé le logiciel gratuit de dessin vectoriel Inkscape pour Editer la couronne et la réenregistrer.
La couronne contient 26 chemins.
J'ai chargé la couronne et j'ai réenregistré en wmf avec le nom couronneIS.wmf
J'ai réenregistré aussi en emf : couronneIS.emf
Ensuite j'ai simplifié les chemins (commande automatique) pour réduire la taille des fichiers
nouveaux fichiers couronneISS.wmf et couronneISS.emf
Tous les fichiers passent en visualisation sauf l'original qui doit avoir un problème.
En pièces jointes tous les fichiers images dans un zip.
Ami calmant, J.P
 

Pièces jointes

Dernière édition:
Bonjour @jurassic pork et oui je te l'ai dit que c’était ta couronne original qui avait un problème
je l'ai refaite avec ma fonction xlcopypicture et la je n'ai plus de problème et quand je les regarde avec paint je ne vois pas de différence

et non le jpg et wmf passe avec loadpicture pas besoin de passerelle

perso j'ai fait un switch
VB:
If " wmf jpg " Like "* " & ListBox1.List(ListBox1.ListIndex, 3) & " *" Then
        framevue.Image1.Picture = LoadPicture(wbk.Path & "\" & ListBox1.List(ListBox1.ListIndex, 2))
    Else
        framevue.Image1.Picture = LoadPngPicture(wbk.Path & "\" & ListBox1.List(ListBox1.ListIndex, 2))
    End If
et voila
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
7
Affichages
470
Retour