Afficher des images Commentaires ou Messages de saisie

Bonjour,

Je cherche à afficher une image pour chaque cellule de la colonne A et pour quatre feuilles du classeur (4/6) lorsque je sélectionne une cellule en colonne A.

Plage A4 : A1000

Affichage par un commentaire ou un message de saisie (je trouve le message de saisie plus esthétique).

La valeur de chaque cellule en colonne A correspond aux noms donnés aux photos rangées dans un seul dossier.

Exemple : Cellule A4 = 8000.10.1508 / Image = 8000.10.1508.jpg

Si la valeur de la cellule ne trouve pas d'image à son nom alors on affiche une image en particulier = Logo.jpg

J'ai trouvé quelques exemples qui correspondent à ce que je recherche.

Notamment les exemples de Boisgontier sur son site internet.

J'arrive d'habitude à adapter les bouts de code que je déniche, sans être un expert en VBA, à mon besoin et ça fait mon affaire.

Pour cette histoire je bloque à adapter les solutions trouvées pour vraiment coller à ma fonction.

Pouvez-vous m'aider ?

Merci par avance !

Bonne journée

Bonjour,

voici un exemple, https://www.cjoint.com/c/GHiaWlQMq0i

Bonjour SabV,

Merci pour ton exemple. C'est vraiment top.

Si je comprends bien, je dois créer une colonne supplémentaire avec le chemin de la photo.

Je règle l'offset selon la colonne où sont les données du chemin.

Mais si je veux réaliser cette macro pour 4 feuilles, il faut que je crée une nouvelle colonne sur chaque feuille (au même emplacement pour que l'offset corresponde).

C'est un petit inconvénient, il y a des feuilles où toutes les colonnes sont utilisées.

Je peux alors sinon recopier cette macro pour chaque feuille ?

Pour exécuter, je vais dans macro, je choisit la macro puis exécuter.

Est-ce que la ou les macro peuvent s'exécuter toutes seules à l'ouverture du fichier ?

Bonjour,

pourriez-vous joindre votre fichier ?

Bonjour SabV,

Je vous joins mon classeur version test ci-dessous :

J'ai besoin de cette macro sur 4 feuilles.

Lorsque l'on clique sur une cellule en colonne "Référence fournisseur" on pourrait voir la photo correspondante.

La valeur de la cellule référence fournisseur = nom de l'image à rechercher.

Toutes les photos sont stockées dans un seul et même dossier sur mon ordinateur.

Si il n'y pas d'image correspondante alors on affiche une image du nom "logo" par exemple.

• Tableau de bord - colonne C
• Produits - Colonne C
• Archives Entrées - Colonne C
• Archives Sorties - Colonne C

Pour les feuilles "Entrées" et "Sorties" il peut y avoir plus d'une centaine de colonnes utiliser.

Merci encore pour l'intérêt que vous portez à mon problème.

Bien cordialement.

Bonjour,

sur la page code de la feuille "Produits"

en supposant que les images soient dans le même répertoire que ce fichier,

sinon remplacer ThisWorkbook.Path par le bon répertoire

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim isect, sh
Set sh = Sheets("Produits")
Set isect = Application.Intersect(Target, sh.Range("C4:C" & sh.Cells(Rows.Count, 1).End(xlUp).Row))
If Not isect Is Nothing Then
    ImageCommentaire Target
End If
End Sub

Sub ImageCommentaire(cell As Range)
    With cell
    .ClearComments
    .AddComment
    .Comment.Text Text:=cell.Value
    .Comment.Shape.Fill.UserPicture ThisWorkbook.Path & "\" & cell.Value & ".jpg"
    .Comment.Shape.Height = 200
    .Comment.Shape.Width = 350
    .Comment.Shape.ScaleHeight 1.2, msoFalse, msoScaleFromTopLeft
    .Comment.Shape.ScaleWidth 1, msoFalse, msoScaleFromTopLeft
    End With
End Sub

Bonjour,

Merci beaucoup pour ton aide.

Ton code fonctionne très bien.

Sauf un petit bug si la photo n'existe pas.

Est-il possible d'ajouter une condition, par exemple :

If cell.value = ThisWorkbook.Path & "\" & cell.Value & ".jpg" Then
Ton code
Else
cell.value = ThisWorkbook.Path & "\" & "logo" & ".jpg" 
End If

J'ai essayer d'intégrer cette condition à ton code mais je suis maladroit.

Peux-tu m'aider pour cette condition.

Merci par avance

Bonne journée

Bonjour,

à tester,

If Not Dir(cell.value) <> "" Then cell.value = ThisWorkbook.Path & "\" & "logo" & ".jpg"

Merci à nouveau pour ta réponse,

Mais mon soucis persiste : chaque cellule qui ne possède pas de photos j'ai l'erreur d'exécution (80070057) "Fichier Introuvable"

Sur la feuille produits :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim isect, sh
Set sh = Sheets("Produits")
Set isect = Application.Intersect(Target, sh.Range("C4:C" & sh.Cells(Rows.Count, 1).End(xlUp).Row))
If Not isect Is Nothing Then
    ImageCommentaire Target
End If
End Sub

Dans un nouveau module :

Sub ImageCommentaire(cell As Range)
Dim Chemin As String

Chemin = "C:\Users\Moi\Desktop\Stock & Matériel\Pièces détachées\Bibliothèque Photos\0_Ensemble\"

    With cell
    .ClearComments
    .AddComment
    .Comment.Text Text:=cell.Value
    .Comment.Shape.Fill.UserPicture Chemin & cell.Value & ".jpg"
    .Comment.Shape.Height = 200
    .Comment.Shape.Width = 350
    .Comment.Shape.ScaleHeight 1.2, msoFalse, msoScaleFromTopLeft
    .Comment.Shape.ScaleWidth 1, msoFalse, msoScaleFromTopLeft
    End With

End Sub

Jusque là tout va bien.

Par contre je ne sais pas à quel endroit je dois placer cette ligne.

If Not Dir(cell.value) <> "" Then cell.value = Chemin & "logo" & ".jpg"

Bonjour,

à tester,

Sub ImageCommentaire(cell As Range)
Dim MonImage As String
MonImage = cell.Value
If Not Dir(ThisWorkbook.Path & "\" & cell & ".jpg") <> "" Then MonImage = "logo"
    With cell
    .ClearComments
    .AddComment
    .Comment.Text Text:=cell.Value
    .Comment.Shape.Fill.UserPicture ThisWorkbook.Path & "\" & MonImage & ".jpg"
    .Comment.Shape.Height = 200
    .Comment.Shape.Width = 350
    .Comment.Shape.ScaleHeight 1.2, msoFalse, msoScaleFromTopLeft
    .Comment.Shape.ScaleWidth 1, msoFalse, msoScaleFromTopLeft
    End With
End Sub

Bonjour SabV,

Merci pour ton suivi.

Ton code fonctionne très bien.

Une petite question :

Visuellement je préfère les bulles que l'on peut créer avec la validation de données :

Dans le message de saisie il faudrait intégrer l'image correspondante.

Est-ce réalisable selon vous ?

Merci par avance

Bonne journée !

Pour complexifier la chose,

J'aimerai que le commentaire s'affiche si et si seulement on sélectionne une ligne.

Si on clique sur la ligne 13, l'image correspondante à la ligne 13 peut s'afficher.

Actuellement la macro confectionné par SabV, me convient parfaitement, fonctionne par survol. Lorsque je glisse le curseur sur une cellule en colonne C le commentaire - image apparait.

J'avais trouvé une fonction qui associe un code et une mise en forme en conditionnelle permettant de remplir d'une couleur la ligne sélectionnée.

Voici une illustration de ma fonction :

L'idéal serait donc que le commentaire soit masqué de manière permanente sauf,

lorsque l'on sélectionne une cellule,

à partir de là on affiche le commentaire - image de la ligne sélectionnée.

Voici le code crée par SabV pour récapituler :

Sur la feuille en question :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    With ThisWorkbook.Names("ActiveRow")
        .Name = "ActiveRow"
        .RefersToR1C1 = "=" & ActiveCell.Row
    End With

Dim isect, sh
Set sh = Sheets("Produits")
Set isect = Application.Intersect(Target, sh.Range("C4:C" & sh.Cells(Rows.Count, 1).End(xlUp).Row))
If Not isect Is Nothing Then
    ImageCommentaire Target
End If
End Sub

Le module :

Sub ImageCommentaire(cell As Range)

Dim MonImage As String
Dim Chemin As String

MonImage = cell.Value
Chemin = "C:\Users\Moi\Desktop\Stock & Matériel\Pièces détachées\Bibliothèque Photos\0_Ensemble\"

If Not Dir(Chemin & cell & ".jpg") <> "" Then MonImage = "Logo"

    With cell
    .ClearComments
    .AddComment
    .Comment.Text Text:=cell.Value
    .Comment.Shape.Fill.UserPicture Chemin & MonImage & ".jpg"
    .Comment.Shape.Height = 150
    .Comment.Shape.Width = 200
    End With

  i = 1
  For Each c In ActiveSheet.Comments
    With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
       Left:=c.Parent.Left + c.Parent.Width - 4, Top:=c.Parent.Top + 1, Width:=4, Height:=4)
      .Fill.ForeColor.RGB = RGB(255, 255, 255)
      .Line.ForeColor.RGB = RGB(255, 255, 255)
      .IncrementRotation 180
      .Name = "commentaire" & i
      i = i + 1
   End With
 Next

End Sub

Peut être que j'en donne un peu trop,

mais j'aimerai vraiment savoir si vous avez des idées ou des solutions.

Salut à tous,

Je tenais à te remercier SabV.

Grâce à ton aide tu m'as mis sur orbite.

Après quelques recherches et quelques tests j'ai trouvé une solution plus esthétique et plus rapide à mon gout que la solution avec les commentaires.

J'ai inséré un Contrôle Image Activex sur la feuille en question.

Selon la cellule que je sélectionne en colonne C, une image apparait dans ce contrôleur d'image.

Clou du spectacle, l'image se déplace selon la cellule sélectionnée.

voici le code qui ne vient pas de moi, mais de multiples contributeurs..

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim chemin As String
Dim logo As String
Dim img As String
Dim cellule As String

chemin = "chemin d’accès" 'chemin d’accès à remplacer par l'adresse d'emplacement des photos'
logo = "chemin d’accès\Logo.jpg" 'chemin d’accès à remplacer par l'adresse d'emplacement des photos'
cellule = ActiveCell.Value
img = chemin & cellule & ".jpg"

    If Dir(img) <> "" Then
        Image2.Picture = LoadPicture(img)
    Else
        Image2.Picture = LoadPicture(logo)
    End If

Shapes("Image2").Top = Target.Top - 0
Shapes("Image2").Left = Target.Left + 710

End Sub