Insérer des photos dans les notes (ex commentaire)

Bonjour le Forum,

Après pas mal de recherche sur le forum et ailleurs, je n'ai pas trouvé exactement ce que je cherchais... Sur le fichier ci-joint je voudrais arriver au résultat suivant:

Que s'affiche une photo dans la note (ex commentaire) lors du survol d'une cellule (colonne N jusqu'à la dernière ligne remplie), et ceci même si les lignes sont filtrées... Les photos seront stockées dans "C:\Private\LCR\5.0\Photos\" et seront nommées suivant le résultat de la formule dans la colonne N et ceci pour les onglets 02 à 14...

Exemple de nom de photo:

Résultat formule N* Nom photo

PVL-003-TGA PVL-003-TGA.jpg

J'ai essayé de m'inspirer de ce sujet, mais je cale...

https://forum.excel-pratique.com/excel/image-en-commentaire-selon-valeur-cellule-24606#p139686

Merci d'avance pour votre aide...

B.A.

Bonjour,

Voici un exemple tiré d'une de mes appli pour intégrer des photos dans des commentaires.

Ici des info sont en ligne 2, les photos sont stockées dans un sous-dossier "\img\", les photos reprennent l'info de la cellule avec l'extension .jpg

par exemple "Pierrep56" en B2 avec une photo Pierrep56.jpg dans \img\

Public Const H0 = 150

Sub IntegrationPhoto()
Dim col As Integer, derlig As Integer, i As Integer
Dim Rep As String, Photo As String, img As IPictureDisp

    With Sheets("Saisie")
        col = .Range("IV2").End(xlToLeft).Column
        Rep = ActiveWorkbook.Path & "\img\"
        For i = 2 To col
            With .Cells(2, i)
                If Not .Comment Is Nothing Then .ClearComments
                If Not .Value = "" Then
                    Photo = Rep & .Text & ".jpg"
                    If Dir(Photo) <> "" Then
                        Set img = LoadPicture(Photo)
                        .AddComment
                        With .Comment
                            With .Shape
                                .Fill.UserPicture Photo
                                .Height = H0
                                .Width = img.Width / img.Height * H0
                            End With
                            .Visible = False
                        End With
                    End If
                End If
            End With
        Next i
    End With
End Sub

Pierre

Bonjour Pierre,

Merci d'avoir pris le temps de me répondre... j'ai un petit souci avec la macro:

Public Const H0 = 150 est affiché en rouge, lorsque je la colle dans la feuille "PORtail"...

Erreur de compilation:

Des constantes, chaînes de longueur fixe, tableaux, types définis par l'utilisateur et instructions Declare ne sont pas autorisés comme membres Public de modules d'objet

SI tu as une idée d'où ça pourrait venir!

Merci d'avance...

B.A.

Bonsoir,

Le code proposé est à copier/coller/adapter dans un module ordinaire et non dans le code d'une feuille (cf menu Insertion/module)

Pierre

Bonsoir Pierre,

J'ai adapté le code à ma situation, ça fonctionne presque comme je voudrais, le petit souci est que si je modifie l'intitulé de la ligne, alors il apparait toujours la photo précédente!

Pour info, si je supprime "Abrév." et "Atelier secteur" de la ligne concernée, il reste toujours à minima le "Numéro" et donc la cellule de la colonne "N" n'est pas vide...

Public Const H0 = 250

Sub IntegrationPhoto()
Dim i As Integer
Dim Rep As String, Photo As String, img As IPictureDisp

    With Sheets("PORtail")
            For i = 3 To 300
                Rep = ActiveWorkbook.Path & "\Photos\"
                    With Cells(i, 14)
                        If Not .Comment Is Nothing Then .ClearComments
                        If Not .Value = "" Then
                            Photo = Rep & .Text & ".jpg"
                            If Dir(Photo) <> "" Then
                                Set img = LoadPicture(Photo)
                                .AddComment
                                With .Comment
                                    With .Shape
                                        .Fill.UserPicture Photo
                                        .Height = H0
                                        .Width = img.Width / img.Height * H0
                                    End With
                                    .Visible = False
                                End With
                            End If
                        End If
                    End With
            Next i
    End With
End Sub

Merci d'avance pour ton aide...

B.A.

Ben c'est pas dur, il suffit d'ajouter un else :

Photo = Rep & .Text & ".jpg"
If Dir(Photo) <> "" Then
    '... blabla
Else
    .ClearComments
End If

Bonjour Pierre,

Merci pour la modif, je vais m'y pencher sérieusement ce week-end et te tiendrais au courant...

Merci encore.

Bonjour Pierre,

Après quelques essais, j'ai le problème suivant:

La macro fonctionne quand je la lance en "manuel" pour l'affichage des "commentaires/photos" et lorsque je modifie/supprime par exemple "atelier secteur", mais ne fonctionne pas de façon "automatique"...

J'ai essayé d'appeler la macro par la feuille

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 14 Then 'Si la valeur change dans la colonne "N/14/Plaque identification"
        Application.EnableEvents = False 'Désactiver les évènements
            Call IntegrationPhoto 'Appeler la macro du module "IntegrationPhoto"
        Application.EnableEvents = True 'Activer les évènements
    End If 'Fin de la condition
End Sub

Module

Public Const H0 = 250

Sub IntegrationPhoto()
Dim i As Integer
Dim Rep As String, Photo As String, img As IPictureDisp

    For i = 3 To 300
        Rep = ActiveWorkbook.Path & "\Photos\"
            With Cells(i, 14)
                If Not .Comment Is Nothing Then .ClearComments
                If Not .Value = "" Then
                    Photo = Rep & .Text & ".jpg"
                    If Dir(Photo) <> "" Then
                        Set img = LoadPicture(Photo)
                        .AddComment
                        With .Comment
                            With .Shape
                                .Fill.UserPicture Photo
                                .Height = H0
                                .Width = img.Width / img.Height * H0
                            End With
                            .Visible = False
                        End With
                Else
                    .ClearComments
                    End If
                End If
            End With
    Next i
End Sub

Mais ça ne fonctionne pas mieux... Peut-être (sûrement) est-ce moi qui ne fait pas les choses correctement!

La solution n'est pas loin, mais avec mon peu de connaissance en VBA ça ne suffit pas!

Merci d'avance pour ton aide.

B.A.

Bonjour,

Perso, je ne ferai pas comme ça.

Dans un module ordinaire, je ferai 3 procédures :

* une pour intégrer UNE seule photo pour UNE ligne

* une autre pour boucler sur les lignes souhaitées cette procédure "ligne unique"

* et une pour effacer tous les commentaires

Option Explicit

Public Const H0 = 250

Sub IntegrationPhoto()
Dim i As Integer

    For i = 3 To 300
        photo_ligne i
    Next i
End Sub

Sub Raz_commentaires()
Dim i As Integer

    For i = 3 To 300
        ActiveSheet.Cells(i, 14).ClearComments
    Next i
End Sub

Sub photo_ligne(lg As Integer)
Dim Rep As String, Photo As String, img As IPictureDisp

    Rep = ActiveWorkbook.Path & "\Photos\"
    With ActiveSheet.Cells(lg, 14)
        If Not .Comment Is Nothing Then .ClearComments
        If Not .Value = "" Then
            Photo = Rep & .Text & ".jpg"
            If Dir(Photo) <> "" Then
                Set img = LoadPicture(Photo)
                .AddComment
                With .Comment
                    With .Shape
                        .Fill.UserPicture Photo
                        .Height = H0
                        .Width = img.Width / img.Height * H0
                    End With
                    .Visible = False
                End With
            Else
                .ClearComments
            End If
        End If
    End With
End Sub

Dans le module ThisWorkbook 2 procédures, une pour "garnir" les commentaires à l'ouverture et une pour les effacer à la fermeture (ça gagne en volume fichier)

Option Explicit

Private Sub Workbook_Open()
    IntegrationPhoto
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Raz_commentaires
End Sub

Ensuite dans le module de la feuille concernée une procédure appelante pour modifier une seule ligne à la fois

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("N3:N300")) Is Nothing Then
        photo_ligne Target.Row
    End If
End Sub

De cette façon on gagne en temps d'exécution et en volume fichier enregistré

Pierre

Re bonjour Pierre,

Les 3 photos que j'utilise pour exemple sont bien présentes lorsque j'ouvre le fichier, mais lorsque je modifie/supprime par exemple "atelier secteur" de la ligne, le "commentaire/photo" de mon exemple est toujours présent!

Je te joins le fichier avec les codes fournis...
Merci vraiment pour ton aide
B.A.

??

Re...

Voici le chemin du fichier:

C:\Private\LCR\PortailImage.xlsm

Le chemin des photos:

C:\Private\LCR\Photos\PCL-001-ACE.jpg

C:\Private\LCR\Photos\PVL-007-ACE.jpg

C:\Private\LCR\Photos\RDM-001-VFS.jpg

Ok, j'avais pas ouvert ton fichier avant.

Si le contenu du nom de la photo dépend d'autres colonnes, il suffit de les intégrer à l'événement Change :

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Union(Range("J3:J300"), Range("L3:N300"))) Is Nothing Then
        photo_ligne Target.Row
    End If
End Sub

Ainsi la procédure 'photo_ligne' est lancée à la modif de J, L, M et N

Bonjour Pierre,

Je voulais te remercier pour ton aide, ça donne le résultat escompté !

Merci encore @+

B.A.