Adaptation des macros d'un membre pour afficher des images en commentaire de cellule

**lolorenzo81** · 28/03/2019, 12h20

Bonjour à tous,

J'essaie de faire fonctionner (sans succès) une des macros qu'un membre du forum partage sur son excellent site http://boisgontierj.free.fr/.

J'ai des milliers de PNG dans un dossier et le nom de ces fichiers est listé dans la colonne d'un fichier Excel.
Je souhaiterais pouvoir, au passage de la souris sur une cellule contenant le nom d'un fichier, avoir un aperçu du PNG correspondant depuis Excel.

Sur le site http://boisgontierj.free.fr/, il y a 2 pistes qui me semblent intéressantes (consistant à faire apparaître les PNGs en commentaire de cellule) :
- http://boisgontierj.free.fr/pages_si...#PhotosComment => fichier InserePhotoCommentaire.xls et ImportPhotoCmt.xls
- http://boisgontierj.free.fr/pages_si....htm#CmtPhoto5 => fichier PhotosCommentaire.xls.

Ne sachant quel fichier privilégier parmi les 3 fichiers .xls mentionnés ci-dessus, je les ai tous téléchargés et j'ai essayé tour à tour :
1. d'y remplacer les noms dans les cellules par les noms de mes PNG (sans mettre ".png") à la fin
2. d'y remplacer tous les ".jpg" par ".png" dans la macro
3. d'y remplacer "ThisWorkbook.Path & "\" ' adapter" par le chemin jusqu'au dossier contenant mes PNG (ex :\DOCS\PHOTOS\PNG)
4. de cliquer sur le bouton GO pour faire fonctionner la macro mise à jour,

mais rien n'y fait, échec cuisant

...

Voyez-vous ce que j'ai pu manquer pour que cela fonctionne ?

Merci d'avance pour votre aide.

--
Lolo

**EricDgn** · 28/03/2019, 16h17

Bonjour,

Effectivement, il semble que les choses aient évolués depuis que boisgontierj a posé ses exemples.
Voici une version adaptée à mon système (Windows 10, Excel 2007):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Sub PhotoEnCommentaire()
  Dim répertoirePhotos As String, sExt As String, sFile As String
  Dim ech As Integer, c As Range
  Dim myShell, myFolder, myFile, Taille
  répertoirePhotos = "D:\! Tests"                  '--- à adapter --- sans \ en fin
  sExt = ".png"                                    '--- extension, à adapter
  ech = 1                                          '--- échelle, à adapter
  For Each c In Range("A2", [A65000].End(xlUp))    '--- noms en colonne A
    c.ClearComments
    If Dir(répertoirePhotos & "\" & c & sExt) <> "" Then
       c.AddComment
       c.Comment.Text Text:=CStr(c.Value)
       c.Comment.Visible = True
       c.Comment.Shape.Fill.UserPicture répertoirePhotos & "\" & c.Value & sExt
       Set myShell = CreateObject("Shell.Application")
       Set myFolder = myShell.Namespace(répertoirePhotos & "\")
       Set myFile = myFolder.Items.Item(c & sExt)
       Taille = myFolder.GetDetailsOf(myFile, 31)              '--- 31
       'Debug.Print Taille
       Taille = Mid(Taille, 2)
       With c.Comment.Shape
         .Height = Val(Split(Taille, "x")(1))
         .Width = Val(Split(Taille, "x")(0))
         .ScaleHeight ech, msoFalse, msoScaleFromTopLeft
         .ScaleWidth ech, msoFalse, msoScaleFromTopLeft
         'Debug.Print c.Value, Taille, .Height, .Width ', .ScaleHeight, .ScaleWidth
       End With
       c.Comment.Visible = False
     Else
       MsgBox "Image non trouvée: " & c, , " Pour info"
     End If
   Next c
End Sub

Je ne sais pourquoi, mais le code plante si on indique directement le \ en fin de nom de dossier.

Pour ce qui est de trouver le n° du "détail", ce code est bien utile:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
'--- https://stackoverflow.com/questions/31989708/vba-make-explorer-exe-remove-file-properties
'--- référence à activer: Microsoft Shell Controls and Automation
Sub ExtendedFileDetails(FolderName As String, FileName As String)
    Dim myFolder As Folder
    Dim myItem As FolderItem
    Dim myShell As New Shell
    Dim i As Long
    Dim Headers(0 To 34) As Variant
    Set myFolder = myShell.Namespace(FolderName)
    Set myItem = myFolder.ParseName(FileName)
    For i = 0 To 34
        Headers(i) = myFolder.GetDetailsOf(myFolder.Items, i)
    Next i
    For i = 0 To 34
        Debug.Print i & vbTab & Headers(i) & vbTab & myFolder.GetDetailsOf(myItem, i)
    Next i
End Sub

Bonne continuation.

**lolorenzo81** · 28/03/2019, 19h41

Merci beaucoup Eric. J'ai essayé ton code dans le fichier Excel de boisgontierj mais ça m'a généré une erreur.

Est-ce que ça te dérangerait de m'envoyer un fichier Excel (compatible Excel 2007) avec ta macro incorporée et 2 ou 3 cellules remplies (A2 à A4) ?
Ensuite, je devrais pouvoir me débrouiller pour l'adapter à mon besoin

.

--
Lolo

**lolorenzo81** · 28/03/2019, 19h54

Ah attends, j'ai essayé ton premier code dans un nouveau fichier Excel et cette fois-ci, ça a marché.

Par contre, les images apparaissent en grande taille et je voudrais les réduire.
Dans ton code, je vois qu'il y a plusieurs références à la taille des images :
- ech = 1
- Taille = myFolder.GetDetailsOf(myFile, 31)
- Taille = Mid(Taille, 2)
- .Height = Val(Split(Taille, "x")(1))
- .Width = Val(Split(Taille, "x")(0)).

J'ai bien essayé de changer le ech = 1 en mettant 0.5, 0.7, etc. mais ça ne fonctionne pas. L'image devient invisible.
Pourtant, quand je mets la valeur 50, ça fait un zoom énorme donc ça marche bien pour les zooms mais pas pour les dézooms.

Pourrais-tu m'indiquer ce qu'il faut changer pour que les images s'affichent en 2 fois moins grand (par exemple) ?
Je précise qu'elles sont toutes carrées et font 512 px de côté.

Merciiiii !

**eriiic** · 28/03/2019, 19h58

Bonjour,

J'ai des milliers de PNG...

Ce n'est pas une bonne idée de les mettre dans le fichier.
C'est valable pour qq dizaines, mais des milliers vont rendre ton fichier obèse, long à charger, et instable avec risque de ne plus pouvoir l'ouvrir.
Tu devrais mettre un seul composant image que tu remplis en cliquant une cellule.
eric

**lolorenzo81** · 28/03/2019, 20h02

Merci d'intervenir Eriiic

.
Tu as dû te rendre compte en me lisant que je ne suis pas un expert d'Excel. Je sais utiliser les fonctionnalités classiques mais au-delà, c'et plus compliqué pour moi.

Par exemple, quand tu dis :

Envoyé par eriiic

Bonjour,

Tu devrais mettre un seul composant image que tu remplis en cliquant une cellule.
eric

je ne sais pas ce que cela signifie ni ce que je dois faire.

Tout ce que je peux te dire, c'est que mon besoin est vraiment de pouvoir visionner depuis Excel des milliers de PNGs afin de mettre dans une colonne supplémentaire un "1" en face de ceux que je veux utiliser et un "0" en face des autres.

Est-ce que ta suggestion irait avec mon besoin bien spécifique ?

Merci de ton aide

.

**eriiic** · 28/03/2019, 23h28

Un exemple rapide à partir d'un fichier de JB.
J'ai prévu une colonne pour le ss-répertoire (à partir du xlsm). Tu peux adapter pour le mettre en dur dans le code, ou au contraire mettre des chemins complets C:\\.....
Tu cliques sur un nom de fichier, l'image s'affiche sur la même ligne.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim rep As String, nf As String, image As Picture
    If Target.Count > 1 Then Exit Sub
    If Target.Column = 2 And Target.Row > 1 Then
        If Target = "" Then Exit Sub
        On Error Resume Next
        Shapes("MonImage").Delete
        On Error GoTo 0
        rep = ThisWorkbook.Path & "\" & Cells(Target.Row, 1)    ' A adapter
        nf = rep & "\" & Target.Value
        Application.EnableEvents = False
        Target.Offset(, 2).Select
        Set image = ActiveSheet.Pictures.Insert(nf)
        image.Name = "MonImage"
        Shapes("monimage").Height = 150    ' On impose la hauteur
        Target.Select
        Application.EnableEvents = True
    End If
End Sub

Nom : 2019-03-28_23-27-45.png
Affichages : 588
Taille : 39,3 Ko

Une seule image est présente dans le fichier. Si c'est pour comparer tu peux en prévoir 2-3 et faire une rotation dessus.
eric

**EricDgn** · 29/03/2019, 10h35

Bonjour,

Pour ce qui est de l'échelle, il faut changer le type de données de ech: Single (au lieu de Integer)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
  Dim ech As Single, c As Range
...
   ech = 0.5

et effectivement ce n'est pas une bonne idée d'intégrer des milliers d'images dans un seul fichier.

Bonne continuation.

**lolorenzo81** · 30/03/2019, 23h31

@eriiic

Merci pour tes explications et désolé pour le délai de ma réponse :-).

En fait, le but n'est pas de renseigner manuellement le nom de mon image mais bien d'avoir des images qui s'affichent d'elles-mêmes à partir de leur nom renseigné dans le fichier Excel.
Et les comparaisons peuvent concerner un nombre d'images beaucoup plus grand que 3.

Imagine-toi un fichier Excel avec 2 colonnes de 10 000 PNG :
- dans la colonne 1 figure la légende du PNG (un mot qui illustre le PNG),
- dans la colonne 2 figure le nom du fichier, un nombre de 6 ou 7 chiffres (120495, 4394838, 495968...).

Grâce à la colonne 1, je classe les PNG par thématique, i.e. que ceux ayant la même légende se retrouvent les uns à la suite des autres.
Ensuite, en cliquant sur la cellule de chaque image, je découvre le PNG et peux donc choisir, parmi tous ceux qui ont la même légende, celui que je vais retenir (pour la légende en question).

Si toi non plus, tu ne vois pas comment faire, il va falloir que je réfléchisse à une autre manière de faire (sans Excel).

--
Lolo

**eriiic** · 31/03/2019, 00h15

Bonjour,

En fait, le but n'est pas de renseigner manuellement le nom de mon image mais bien d'avoir des images qui s'affichent d'elles-mêmes à partir de leur nom renseigné dans le fichier Excel.

Je ne comprend pas bien. Qui te parle de les mettre manuellement ? Tu fait comme tu veux, il faut qu'ils y soient c'est tout.

Imagine-toi un fichier Excel avec 2 colonnes de 10 000 PNG

Je préfère pas non

Ensuite, en cliquant sur la cellule de chaque image, je découvre le PNG

C'est très exactement ce que fait ma proposition.
Un clic dans la cellule au lieu d'un survol dans le cas d'un commentaire.
Sauf que moi elle n'est chargée et elle seule qu'au moment du besoin.
Tu n'as rien testé de ma proposition quoi...
eric

**lolorenzo81** · 01/04/2019, 15h58

Merci EricDgn (je n'avais pas vu ta dernière réponse).

**lolorenzo81** · 01/04/2019, 16h05

Envoyé par eriiic

Bonjour,

Je ne comprend pas bien. Qui te parle de les mettre manuellement ? Tu fait comme tu veux, il faut qu'ils y soient c'est tout.

C'est très exactement ce que fait ma proposition.
Un clic dans la cellule au lieu d'un survol dans le cas d'un commentaire.
Sauf que moi elle n'est chargée et elle seule qu'au moment du besoin.
Tu n'as rien testé de ma proposition quoi...
eric

Excuse-moi, je n'avais pas testé car en lisant tes explications, j'ai mal interprété ce que faisait ton code

.
Du coup, je viens de réessayer dans un Excel from scratch mais je n'arrive pas à déclencher ta macro.

Jusqu'à maintenant, j'avais l'impression que pour créer et exécuter une macro, il fallait aller dans Visual Basic > Insertion > Module, puis copier / adapter le code et sauvegarder le tout.
Mais quand je vais ensuite dans les macros listées, il n'y a rien... J'ai testé la sauvegarder en xls et xlsm, mais sans succès

.

Donc pour le moment, impossible de vérifier que ta macro fait ce que tu me dis qu'elle fait.
Et concernant le chemin absolu, c'est un dossier du genre D:\DOSSIER1\DOSSIER2\DOSSIER3\DOSSIER4\...\IMAGES et il passe en rouge quand je le mets en dur dans ton code (signe a priori d'une erreur).

Bref, je suis un cassos en VBA / Macros...

**Patrice740** · 01/04/2019, 16h16

Envoyé par lolorenzo81

Jusqu'à maintenant, j'avais l'impression que pour créer et exécuter une macro, il fallait ....
Bref, je suis un cassos en VBA / Macros...

Bonjour,

Voir ce tuto :
http://silkyroad.developpez.com/VBA/DebuterMacros/

**eriiic** · 01/04/2019, 16h40

Bonjour,

c'est une macro événementielle (se déclenche sur une sélection), c'est donc à mettre dans le module de la feuille concernée, pas dans un module standard.

Quant au chemin, j'ai pris comme base un sous-répertoire du répertoire du fichier avec macro :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

rep = ThisWorkbook.Path & "\" & ...

met ce qui va bien.
Pour tester tu peux remplacer par rep = Cells(Target.Row, 1) et mettre le chemin en dur dans la colonne A (sans "\" à la fin).
Tu fignoleras ensuite

Le fichier est à 'Enregistrer sous ...' avec le type *.xlsm
eric

**lolorenzo81** · 02/04/2019, 18h48

Merci eriiic.

Nom : 2019-03-28_23-27-45.png
Affichages : 588
Taille : 39,3 Ko

Après 1 heure de test, je n'y arrive pas encore

.

1. Le _ devant le sous-répertoire est-il obligatoire ou l'as-tu mis car ton répertoire démo contenait le underscore en premier caractère ?

2. Sachant que les images sont dans un sous-répertoire "PNG" du répertoire contenant mon fichier macro.xlsm, on est bien d'accord que si je mets en colonne A du fichier Excel "PNG" (ou "_PNG" suivant ta réponse à ma question précédente), je ne touche pas à la ligne : rep = ThisWorkbook.Path & "\" & Cells(Target.Row, 1) ?

3. Ensuite, j'ai a priori bien ajouté ton code en tant que module de la feuille contenant les data :

Nom : macro.jpg
Affichages : 379
Taille : 196,2 Ko

Nom : macro.jpg
Affichages : 379
Taille : 196,2 Ko

mais cela ne réglait pas le problème de génération de macro.
En touchant un peu à tout, j'ai réussi à voir afficher la macro dans le listing des macros grâce à la présence de :

Sub macro()

End Sub

mais je ne sais pas si :
- j'ai bien fait
- le code est au bon endroit.

Quoi qu'il en soit, le résultat escompté n'est toujours pas là.

Merci encore pour le temps que tu prends à m'expliquer.

--
Lolo

**eriiic** · 02/04/2019, 19h12

Bonjour,

1. mon rep contenait le _

2.

Sachant que les images sont dans un sous-répertoire "PNG" du répertoire contenant mon fichier macro.xlsm, on est bien d'accord que si je mets en colonne A du fichier Excel "PNG" (ou "_PNG" suivant ta réponse à ma question précédente), je ne touche pas à la ligne : rep = ThisWorkbook.Path & "\" & Cells(Target.Row, 1) ?

Ben si justement, c'est celle où je t'avais mis 'A adapter. Ca devient :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

rep = ThisWorkbook.Path & "\PNG\" & Cells(Target.Row, 1)    ' A adapter

Et tu ne t'occupes plus de A puisque c'est inscrit en dur dans la macro.

Comme c'est une macro événementielle c'est à mettre dans le module de la feuille concernée Feuil1 (Feuil1) ou autre, pas dans un module standard.
Je t'ai ajouté qq contrôles pour éviter les plantages (image absente):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim rep As String, nf As String, image As Picture, ext As String
    If Target.Count > 1 Then Exit Sub
    If Target.Column = 2 And Target.Row > 1 Then
        If Target = "" Then Exit Sub
        On Error Resume Next
        Shapes("MonImage").Delete
        On Error GoTo 0
        rep = ThisWorkbook.Path & "\PNG\" & Cells(Target.Row, 1)    ' A adapter
        nf = rep & "\" & Target.Value
        ext = Mid(Target.Value, InStrRev(Target.Value, ".") + 1)
        If InStr("png,jpg,bmp", ext) > 0 And Dir(nf) <> "" Then
            Application.EnableEvents = False
            Target.Offset(, 2).Select
            Set image = ActiveSheet.Pictures.Insert(nf)
            image.Name = "MonImage"
            Shapes("monimage").Height = 150    ' On impose la hauteur
            Target.Select
            Application.EnableEvents = True
        End If
    End If
End Sub

**lolorenzo81** · 02/04/2019, 22h20

T'es un boss, merci eriiic !

Par contre, l'image s'affiche comme ci-dessous à gauche.
Est-ce qu'une ligne de code supplémentaire permettrait d'afficher l'image (plus ou moins) comme ci-dessous à droite ?

Nom : macro.jpg
Affichages : 381
Taille : 74,7 Ko

Nom : macro.jpg
Affichages : 381
Taille : 74,7 Ko

**eriiic** · 02/04/2019, 22h48

Si ça s'affiche comme à gauche c'est que tu as (mal) modifié le code.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Target.Offset(, 2).Select

signifie même ligne (rien ou 0 devant la "," et 2 colonnes à droite
même ligne et 1 colonne à droite :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Target.Offset(, 1).Select

eric

**lolorenzo81** · 03/04/2019, 02h15

L'image de gauche correspond au rendu sans que je ne touche à ton code.
Et quand je modifie le (, 2) par (1, 1), (, 5) ou autre, cela n'a aucune incidence sur la position de l'image.

De plus, si je scrolle vers le bas, je ne vois plus l'image car elle est en position absolue dans le classeur (comme tu peux le voir ici).

Cela pourrait-il venir du fait qu'Excel 2007 n'est pas capable d'interpréter toutes les instructions de ton code VBA ?

--
Lolo

**eriiic** · 03/04/2019, 08h20

Bonjour,

Ca m'étonnerait fort que 2007 interprète mal Target.Offset(y, x).Select
Là je n'ai pas d'explication.
On va essayer de la déplacer après création. Ajoute

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Shapes("monimage").Top = Target.Offset(, 1).Top
Shapes("monimage").Left = Target.Offset(, 1).Left

après Shapes("monimage").Height = 150

De plus, si je scrolle vers le bas, je ne vois plus l'image car elle est en position absolue

Oui c'est normal. Tu n'avais jamais demandé cela.
Mais tant que l'image ne se place pas où c'est prévu pas la peine de compléter le code.
eric

Adaptation des macros d'un membre pour afficher des images en commentaire de cellule [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager