XL 2021 Extraction images depuis commentaire de cellule vers dossier.

[jeff1494]

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.

 

[laurent950]

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

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 i
    End If
    Next
    Sheets("Feuille_Transit").ChartObjects(Sheets("Feuille_Transit").ChartObjects.Count).Delete
    Application.DisplayAlerts = False
    Sheets("Feuille_Transit").Delete
    Application.DisplayAlerts = True
End Sub
Sub save_comment_fichier_jpg(x)
    Application.ScreenUpdating = False
    With Sheets("INVENDUS").Cells(x, 2)
        If Not .Comment Is Nothing Then
            .Comment.Visible = True
            .Comment.Shape.CopyPicture
            With Sheets("Feuille_Transit").ChartObjects("calque")
            .Height = Sheets("INVENDUS").Cells(x, 2).Comment.Shape.Height
            .Width = Sheets("INVENDUS").Cells(x, 2).Comment.Shape.Width
            .Activate ' Il manquait cela : .Activate
                .Chart.Paste
                .Chart.Export ThisWorkbook.Path & "\JPG_INV\" & Sheets("INVENDUS").Cells(x, 1) & ".jpg", "JPG"
            End With
            .Comment.Visible = False
        End If
    End With
    Application.ScreenUpdating = True
End Sub

 

[fanch55]

Bonsoir à tous,
Le fonctionnement semble également correct si on ne fait pas de ScreenUpdating ..... 🤔

 

[patricktoulon]

Bonsoir
le do loop sur le paste dans le chart !!!!! il est ou ???????????????????

 

[jurassic pork]

Hello,
quelques remarques concernant le code de Laurent950 :
1 Quand on fait un CopyPicture sans option c'est l'équivalent d'un xlScreen, xlPicture
ce qui fait que l'on a dans le presse-papier un format EnhancedMetafile mais quand l'image d'origine est une image Raster comme c'est
le cas ici cela ne sert à rien car je soupçonne Excel de convertir l'image d'origine en format EnhancedMetafile mais avec une image raster
à l'intérieur ce qui ne sert à priori à rien car on a alors la même qualité.
J'ai fait l'essai de mettre à la place du CopyPicture , CopyPicture xlScreen, xlBitmap et je n'ai pas vu de différence de qualité par rapport
au xlPicture. Par contre en temps de traitement il y a une différence.
En Excel 2016 pour copier les 5 images des commentaire avec l'option xlPicture : 350 ms
avec l'option xlBitmap : 250 ms
A cela il faut rajouter une cinquantaine de millisecondes pour les autres étapes (avec l'objet Chart) pour 5 images.
Et pour la remarque de Fanch55 concernant le ScreenUpdating en l'utilisant on gagne une centaine de millisecondes pour 5 images.
A noter aussi qu'on peut très bien se passer de l'objet Chart en sauvegardant directement le Bitmap à partir du presse-papiers.
Pour cela on peut utiliser du code VBA (patricktoulon a déjà réalisé cela) ou alors la fonction saveImage de la classe Pressepapier de
mon complément Excel XlDnaLibJP.
Voici le code avec ma fonction saveImage :

Sub Export_PhotosJP()
    Dim i As Long
    On Error Resume Next
    MkDir ThisWorkbook.Path & "\JPG_INV"
    Err.Clear
    On Error GoTo 0
    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_jpgJP i
    End If
    Next
End Sub
Sub save_comment_fichier_jpgJP(x)
    Dim pp As Object, data As Object
    Set pp = CreateObject("XlDnaLibJP.PressePapier")
    Application.ScreenUpdating = False
    With Sheets("INVENDUS").Cells(x, 2)
        If Not .Comment Is Nothing Then
            .Comment.Visible = True
            .Comment.Shape.CopyPicture xlScreen, xlBitmap
            pp.SaveImage ThisWorkbook.Path & "\JPG_INV\" & Sheets("INVENDUS").Cells(x, 1) & ".jpg", 1 ' 1 = format jpeg
            .Comment.Visible = False
            pp.Clear
        End If
    End With
    Application.ScreenUpdating = True
End Sub

Avec ce code j'obtiens un temps de 85 ms pour 5 images

Ami calmant, J.P

 

[jeff1494]

Bonjour à vous :
Je vous remercie pour vos réponses, mais il y a une chose que je ne comprends pas.
Quant Patrick dit :

le do loop sur le paste dans le chart !!!!! il est ou ???????????????????

Et quand je regarde le code correspondant au lien que je donne dans mon premier message à savoir je ne trouve aucune référence à ce que dit @patricktoulon, soit un Do Loop . Mais je peux faire une erreur bien sûr.

Dans tous les cas je vous remercie tous et vais regarder de plus près tout cela.
Je remercie @laurent950 pour son lien qui va me permettre de comprendre tout cela, ainsi que pour son code que je vais utiliser dans l'immédiat.

@jurassic pork merci pour ton code que je vais peut-être utiliser.
Je dois juste voir ce à quoi correspond en détail ton complément XlDnaLibJP et voir comment je pourrais le réutiliser.
Je dois repasser cet outil que je suis en train de faire à une personne et je dois alors, si j'utilise un complément, pouvoir l'installer sur sa machine. Et cela je ne sais pas encore comment gérer cela.

Merci à @patricktoulon pour son code qui m'a servi de base pour que je puisse remplir cette fonction. Je recherche très souvent dans ses messages pour trouver une solution à mes problèmes, car comme vous l'êtes aussi, il reste une référence à mes yeux.

Je vous souhaite à tous une bonne journée.

 

[patricktoulon]

tu a certainement trouver une vielle fonction de 2018 ou inférieure
dans les versions qui ont suivi j'ai ajouter un do loop tant que le pictures.count du chart n'est pas à 1
ça permet d’éviter l'image blanche parce que le clipboard n'a pas eu le temps de coller les datas de l'images entièrement dans le chart
c'est un problème récurent à partir de la version excel 2016

 

[jeff1494]

Pour @patricktoulon , en effet quand je regarde la date de ton message on remonte en 2016. Donc cela fait un bail.
Mais comme je ne suis pas capable de savoir ce qui change entre les différentes versions d'Excel, j'ai lâchement pompé ton code.
De toutes les façons je te remercie pour ton aide précieuse.

 

[jeff1494]

Bonjour à toutes et tous;

Je viens de tester cette sauvegarde des photos dans un répertoire sur un fichier qui contient plus ou moins 300 lignes. Comme vous vous en doutez cela prend beaucoup de temps. J'ai utilisé pour faire cela, la solution donnée par @patricktoulon (avec la correction de @laurent950 ).

Je vais donc tester le complément de @jurassic pork et voir le résultat.
Si cela va bien il faudra alors que je puisse installer le complément sur la machine de la personne qui devra utiliser cette petite application.

Par contre je ne sais pas comment faire cela.

Donc si @jurassic pork passe par là, et si de plus il pouvait m'expliquer comment si il est possible de vérifier si le complément est installé ou pas et dans le cas ou il n'est pas installé, le mettre en place.
Et si il est possible de la désinstaller , j'en serais très heureux. Le tout via des macros VBA.

Dans l'idéal j'aimerais bien faire cela lors de la première ouverture du fichier.
Une autre possibilité serait peut-être d'installer le complément à l'ouverture (dans Workbook_Open par exemple) et de le désinstaller à la fermeture du fichier (par exemple dans Workbook_BeforeClose).

Je parle comme si je connaissait tout cela sur le bout des doigts, mais je ne sais même pas si cela est possible techniquement.

En attendant je vous souhaite une bonne journée à toutes et tous.

 

[jurassic pork]

Je vais donc tester le complément de @jurassic pork et voir le résultat.
Si cela va bien il faudra alors que je puisse installer le complément sur la machine de la personne qui devra utiliser cette petite application.
Par contre je ne sais pas comment faire cela.
Donc si @jurassic pork passe par là, et si de plus il pouvait m'expliquer comment si il est possible de vérifier si le complément est installé ou pas et dans le cas ou il n'est pas installé, le mettre en place.
Et si il est possible de la désinstaller , j'en serais très heureux. Le tout via des macros VBA.

Hello,
c'est très facile à installer car il y a un installeur ( 1 pour une Excel version 32 bits, 1 pour une version Excel 64 bits). Il suffit de lancer l'installeur et de suivre ce qui est indiqué et le complément est installé automatiquement dans les addins de l'utilisateur qui l'installe. Il suffit seulement après installation d'aller dans les options/compléments d'Excel et d'atteindre les compléments d'Excel et cocher XlDnaLibJP. Pour voir si il est installé et activé , il y a un onglet Démo ExcelDNA qui a du apparaître dans le ruban. Pour cacher cet onglet utiliser personnaliser le ruban.
Pour la désinstallation c'est aussi facile puisque le complément est dans le Ajouter et Supprimer des programmes de Windows.
Ami calmant, J.P

 

[jeff1494]

Bonjour @jurassic pork ;

Merci à toi pour les informations, je vais donc regarder comment faire tout cela en VBA.
Donc si je comprends bien, ce que je dois faire :

A l'ouverture de mon fichier​

1. , vérifier si le complément est installé.
   1. Si oui, je passe à la suite.
   2. Si non, je dois vérifier la version d'Excel (32 ou 64 bits), et lancer l'installateur correspondant depuis Excel.
2. Aller dans les options/compléments d'Excel et d'atteindre les compléments d'Excel et cocher XlDnaLibJP.

Lors de la fermeture du classeur :​

1. Aller dans les options/compléments d'Excel et d'atteindre les compléments d'Excel et décocher XlDnaLibJP.
2. Puis fermer le classeur en sauvegardant mes modifications.

Suis-je correct ? Le tout en VBA !

Voilà encore un challenge pour moi. Comme quoi une simple petite application, peut devenir un moyen d'en apprendre un maximum, juste en se posant des questions toutes bêtes.

Encore merci et bonne journée à toi.

 

[jurassic pork]

Bonjour @jurassic pork ;

Merci à toi pour les informations, je vais donc regarder comment faire tout cela en VBA.
Donc si je comprends bien, ce que je dois faire :

A l'ouverture de mon fichier​

1. , vérifier si le complément est installé.
   1. Si oui, je passe à la suite.
   2. Si non, je dois vérifier la version d'Excel (32 ou 64 bits), et lancer l'installateur correspondant depuis Excel.
2. Aller dans les options/compléments d'Excel et d'atteindre les compléments d'Excel et cocher XlDnaLibJP.

Lors de la fermeture du classeur :​

1. Aller dans les options/compléments d'Excel et d'atteindre les compléments d'Excel et décocher XlDnaLibJP.
2. Puis fermer le classeur en sauvegardant mes modifications.

Suis-je correct ? Le tout en VBA !

Voilà encore un challenge pour moi. Comme quoi une simple petite application, peut devenir un moyen d'en apprendre un maximum, juste en se posant des questions toutes bêtes.

Encore merci et bonne journée à toi.

Il ne faut pas installer depuis Excel mais depuis l'explorateur windows. Double cliquer sur l'installeur .exe correspondant à la version d'Excel.
Pourquoi désactiver le complément à la fermeture ? ce n'est pas la peine. Il ne gêne pas Excel et ne le ralentit pas. La seule chose à faire c'est de désactiver l'onglet Démo ExcelDna du ruban avec personnaliser le ruban qui ne sert qu'avec le classeur de démo.

 

[patricktoulon]

re
Bonjour

perso je pige pas trop si tu utilise le complément de @jurassic pork tu n'a pas besoins du grab des images par le graph
@jurassic pork infirmera ou confirmera

 

[jeff1494]

Bonjour @patricktoulon ;

En fait je cherche la meilleur solution pour faire cette manip.

J'ai essayé ton code en premier, et mon problème est que je trouve que cela prend beaucoup trop de temps, je parle de plusieurs minutes pour plus ou moins 300 photos (ce qui représente un nombre normal d'objets mis en vente pour cette application). Cela fonctionne parfaitement mais prend du temps.

Je veux donc essayer de voir le résultat avec la solution proposée par @jurassic pork .
Si elles est plus rapide alors je l'adopterai.
Comme c'est un complément et que la personne à qui est destiné cette application, ne maitrise pas du tout ce genre de manipulation (installer, et activer un complément), je me demande simplement si je peux réaliser cela en automatique.

Voilà où j'en suis.

 

[jurassic pork]

je confirme ce qu'a dit PatrickToulon , on passe directement du presse-papiers au fichier image.
Pour jeff si ce n'est pas toi qui fait l'installation chez la personne, avec des copies d'écran cela devrait réalisable par la personne.