Lier une image à une cellule automatiquement

Bonjour à tous.

Après lecture du (es) forum, j'ai presque résolu mon problème mais il me manque des éléments que je n'ai pas trouvé.

J'ai un fichier Excel qui me permet de voir en l'instant T l’état de mon stock de mobilier. Dans ce tableau, au lieu d'avoir un lien qui envoie vers la photo du mobilier, je souhaiterais faire apparaitre directement la photo dans la cellule. N'étant pas tous seul à utiliser ce fichier, j'aimerais automatiser au mieux l'ajout de la photo pour que les collègues n'aient pas à redimensionner et lier la photo à chaque fois.

Dans un premier temps j'ai crée un bouton d'insertion de photo avec la sélection de la photo dans le dossier cible. Par contre je ne trouve pas comment dimensionner automatiquement la photo et la lier à la cellule ? Sachant que j'ai 6 feuilles de mobilier différents avec une 50aine de références pour chacune d'elles ?

Merci d'avance pour l'aide.

Edit:

J'ai rajouté le fichier pour donner une idée de la chose, il est en cours de réalisation, seule la dernière feuille est à jour

Bonjour,

Peut-être trouveras-tu des pistes de solution sur le site remarquable de Jacques Boisgontier : à la rubrique image

http://boisgontierjacques.free.fr/

Bonjour,

Après avoir testé les différentes macro, il ne manque que la fonction avec laquelle je puisse choisir dans le dossier la photo qui m’intéresse. Pour la "calibrer" et la mettre dans une cellule active, c'est bon.

Merci d'avance et merci encore pour le lien

Edit: Solution trouvée

Si ca peut interesser du monde voici le code:

Sub Chaises_Bouton2_Clic()

    Dim Emplacement As Range
    Dim Img As Object
    Dim ShapeObj As Shape

    If Application.Dialogs(xlDialogInsertPicture).Show Then
        'Définit l'emplacement de l'image
        Set Emplacement = ActiveCell

        Set Img = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)

        With Img.ShapeRange

            .Name = "Cible"
            .LockAspectRatio = msoFalse
            .Left = Emplacement.Left
            .Top = Emplacement.Top
            .Height = Emplacement.Height
            .Width = Emplacement.Width
        End With

    Else
        MsgBox "Insertion d'image interrompue."
    End If

End Sub

Edit2:

Derniere demande si c'est faisable: est-il possible, une fois la photo ajouter de la deselectionner et de selectionner la cellule suivante?

Merci

Bonjour, j'ai une question qui se refere a ce probleme.

Je possede un fichier dans lequel j'insere une quantité très importante d'images. Ces images proviennent d'un dossier precis.

Une fois toute les images inserées, le fichier excel ne pese que 700k. Cela s'explique par le fait que les images inserées ne le sont pas réelement. En effet si je supprime mon dossier contenant mes images, en ouvrant mon fichier excel, toute les images disparaissent avec.

Est_il donc possible d'inserer concretement les images a mon fichier excel, meme si le poid risque d'etre très elevé ?

J'ai insere mon code a la suite.

merci beaucoup de votre aide !

Sub insert_image_Story_Story() 'Inserer l'images storyboard (Story)

Dim lepath As String, Limage As String, Name As String
Dim NewImg As Object

Application.ScreenUpdating = False

lepath = ActiveWorkbook.Path & "\PREPA\05_Storyboard\Screens\"
Limage = ActiveCell.Offset(-1, 1).Value
Name = "Screen_"

If Sheets("Config").Range("B15") <> "" Then
   lepath = Sheets("Config").Range("B15") & "\"
End If

If Sheets("Config").Range("B27") <> "" Then
   Name = Sheets("Config").Range("B27")
End If

Set NewImg = ActiveSheet.Pictures.Insert(lepath & Name & " (" & Limage & ").png")
With NewImg
    .ShapeRange.Left = ActiveCell.Left
    .ShapeRange.Top = ActiveCell.Top
    .Height = ActiveCell.Height
    .Name = "Shape" & Limage
    .Width = 375
    .Placement = xlMoveAndSize

ActiveSheet.Shapes("Shape" & Limage).Copy