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.