Afficher une image venant d'ailleurs d'après résultat

Bonjour à tous,

Quelqu'un saurait-il me dire si il y a moyen simpliste d'afficher une image dans une cellule en fonction de la valeur d'une autre cellule.

Cette image serait stockée dans un dossier.

Cf.fichier joint pour l'exemple.

J'avais imaginé créer un lien hypertexte vers la photo

Merci de vos aides précieuses,

E.Kytockx

Bonjour,

Essaie ainsi :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim dossImg As String, nomImg As String, Img As Object
    If Target.Address = "$A$1" Then
        On Error Resume Next
        Me.Shapes(Me.Shapes.Count).Delete
        On Error GoTo 0
        nomImg = Target.Value
        If nomImg <> "" Then
            nomImg = nomImg & ".jpg"
        Else
            Exit Sub
        End If
        dossImg = "D:\Users\Documents\" 'A remplacer par le chemin du dossier si pas le bon
        On Error GoTo errimg
        Set Img = Me.Pictures.Insert(dossImg & nomImg)
        On Error GoTo 0
        Img.Left = Me.Range("B2").Left
        Img.Top = Me.Range("B2").Top
        Img.Width = Me.Range("B2").Width
    End If
    Exit Sub
errimg:
    If Err.Number = 1004 Then
        MsgBox "L'image " & nomImg & " n'a pas été trouvée dans le dossier " _
         & dossImg & ".", vbInformation, "Erreur Image"
    Else
        Resume Next
    End If
End Sub

Si le chemin du dossier contenant les images est le bon, faire essai direct... sinon changer dossier avant.

Cordialement.

Bonjour MFerrand,

Merci pour ton retour, après l'avoir adapté à mon fichier cela fonctionne.

Par contre quelques petits réglages en plus:

• Quand je modifie la valeur cible avec la validation de données et que l'image s'affiche, ma validation de données n'est plus disponible. Je dois enregistrer pour l'avoir de nouveau disponible.
• Quand je modifie la valeur cible et que l'image correspondante s'affiche, elle n'écrase pas la précédente.
• je souhaiterais centrer l'image dans la cellule et l'avoir légèrement plus petite que la cellule pour ne pas cacher les bordures.

Bien Cordialement,

Kytockx

Bonjour,

A défaut d'information, la largeur de l'image a été alignée sur celle de la cellule...

Précise-moi dans quelle proportion tu veux qu'elle soit réduite.

Pour la suppression de l'image antérieure, la ligne :

Me.Shapes(Me.Shapes.Count).Delete

est censée le faire, et cela fonctionnait chez moi.

Elle est mise sous gestion d'erreur car si rien à supprimer cela engendrait naturellement une erreur...

Il faudrait que tu mettes une apostrophe devant la ligne précédente (On Error Resume Next) pour l'invalider momentanément et voir si une erreur se produit sur cette ligne.

Et me communiquer le numéro d'erreur (ou son libellé).

Pour le problème de liste déroulante, il faut que je teste, donc que j'aménage pour pouvoir le faire car ta liste déroulante ne correspond à rien chez moi... Tu vas devoir attendre un peu, que j'écluse les sujets en cours que j'ai sur les bras et que j'ai fait mes approvisionnements alimentaires pour la période...

Cordialement.

Re-Bonjour MFerrand,

Quand je mets une apostrophe devant la ligne "On Error Resume Next", rien ne se passe de différent, pas de message d'erreur et toujours pas de suppression de l'image précédemment affichée.

Merci de ton aide...et bonnes courses !

Bonsoir,

Tu bénéficies du fait que j'ai reporté mes courses à demain et me suis contenté d'une sortie locale et du contenu de mon frigo !

J'aurais dû me souvenir que la flèche des listes déroulantes est objet Shape, j'ai déjà eu maille à un problème avec, et qu'effectivement en supprimant le dernier objet Shape de la feuille en démarrant sans image on allait le supprimer !

Mais apparemment cet objet semble prendre toujours le dernier numéro d'index, et c'est donc lui qui est supprimé ! ce qui explique tes problèmes. J'ai noté aussi qu'il changeait parfois de nom mais je n'ai pu en déterminer le contexte...

Donc quelques petites modifications pour régler ce problème, + les autres questions soulevées :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim dossImg As String, nomImg As String, Img As Object
    If Target.Address = "$A$1" Then
        On Error Resume Next
        Me.Shapes("Image").Delete
        On Error GoTo 0
        nomImg = Target.Value
        If nomImg <> "" Then
            nomImg = nomImg & ".jpg"
        Else
            Exit Sub
        End If
        dossImg = "D:\Users\Documents\"
        On Error GoTo errimg
        Set Img = Me.Pictures.Insert(dossImg & nomImg)
        On Error GoTo 0
        Img.Left = Me.Range("B2").Left+ 10
        Img.Top = Me.Range("B2").Top
        Img.Width = Me.Range("B2").Width- 20
        Img.Name = "Image"
    End If
    Exit Sub
errimg:
    If Err.Number = 1004 Then
        MsgBox "L'image " & nomImg & " n'a pas été trouvée dans le dossier " _
         & dossImg & ".", vbInformation, "Erreur Image"
    Else
        Resume Next
    End If
End Sub

On nomme l'image pour la supprimer par son nom d'une part.

Et d'autre pour ajuster la largeur et le centrage sur B, tu peux modifier le réglage à ta convenance : le nombre que tu déduis sur Width, tu en ajoutes la moitié sur Left, donc en modifiant ces 2 nombres mais en conservant leur rapport tu obtiens la largeur qui te convient et tu conserves le centrage sur la colonne.

Cordialement.

Bonjour MFerrand,

Merci pour ton retour cela fonctionne désormais trés bien !

Concernant les images, elles sont donc stockées dans un dossier séparé mais ne font pas forcément tous la même dimensions.

N'existe-t-il pas une fonction 'resize' pour l'adapter et la contraindre à rentrer dans les dimensions de ma cellule hauteur =66 (88 pixels) largeur= 11,86 (88pixels) et hauteur.

Le but est d'automatiser le système pour éviter de passer par une retouche de l'image via un autre logiciel.

Merci de ton aide

Bien Cordialement,

Kytockx

Si je comprends bien, ta cellule fait 88 x 88 et tu veux que l'image entre dans 66 pour sa plus grande dimension ?

Re-,

Les dimensions en pixels sont celles données par excel entre parenthèse.

J'ai plusieurs images qui peuvent effectivement de dimensions > à celles de ma cellule, tout comme elles peuvent être < aux dimensions de ma cellule. J'ai un melting pot de photos de différentes dimensions mais qui doivent apparaître spécifiquement dans cette cellule, sans dépasser et tout en restant "lisibles".

A ta dispo si mes explications ne sont pas assez claires;

Bien Cordialement,

Kytockx

11,86 ça donne bien 66 (pas très grand). Si ta cellule est carrée, elle fait donc 66 x 66...

Essaie cette modification :

        On Error GoTo 0
        If Img.Height > Img.Width Then
            Img.Height = 60
        Else
            Img.Width = 60
        End If
        Img.Left = Me.Range("B2").Left + 3
        Img.Top = Me.Range("B2").Top + 3
        Img.Name = "Image"
    End If

Cordialement.

Re-,

J'ai essayé comme ceci:

On Error GoTo 0
        If Img.Height > Img.Width Then
            Img.Height = 80
        Else
            Img.Width = 80
        End If
        Img.Left = Me.Range("D2").Left + 10
        Img.Top = Me.Range("D2").Top + 10
        Img.Name = "Image"
    End If

ça semble donner un résultat correct; je vais essayer de le tester à plus grande ampleur maintenant.

Je referai un post après test.

Merci de ton aide en tout cas,

Bien Cordialement,

Kytockx