Insertion une image automatiquement via lien externe

[Marilo]

Bonjour,

voilà j'aimerais insérer un eimage via excel à partir d'un fichier ranger dans un dossier.
Ainsi je voudrais par exemple:
Si A1=1 , l'image 1.jpg s'affiche, si A2=2, l'image 2.jpg s'affiche etc etc. sachant que toutes les images ont le même chemin d'accès.

Cela est-il possible?

Merci d'avance

Louis

 

[MichD]

Re : Insertion une image automatiquement via lien externe

Bonjour,

Insère tout le code dans le module feuille où l'action de déroule.
Adapte la valeur des variables.

(Je n'ai pas testé...)

'Déclaration de la variable dans le haut du module
Dim NoImage As Integer
'-------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Repertoire As String, NomImage As String
Repertoire = "C:\Users\Nom du profil\Pictures\"
On Error Resume Next
If Target.Address = Range("A2").Address Then
    'suppression de l'image
    Me.Shapes("Image " & [NoImage]).Delete
    Select Case Target.Value
        Case 1
            NomImage = "toto.jpg"
        Case 2
            NomImage = "tito.jpg"
        Case 3
            NomImage = "tAto.jpg"
    End Select
    'Me.name = Nom de la feuille
    'Range("b2:c2")= Étendue de l'image insérée dans la feuille, à adapter
    'Repertoire & NomImage = chemin + nom de l'image
    InsérerImage Me.Name, Range("b2:c2"), Repertoire & NomImage
End If
End Sub

'-------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = Range("A2").Address Then
    'Création d'un NOM pour storer la valeur de la cellue A2
    'Cette valeur correspond à l'index de l'image requis pour
    'Pouvoir supprimer l'image s'il y a modification de la
    'valeur en A2. Ce nom n'est pas visible dans l'interface
    'de la feuille de calcul, propriété visible = False
    Names.Add "NoImage", Target.Value, False
End If
End Sub

'-------------------------------------------------------
Sub InsérerImage(Feuille As String, RgImage As Range, NomImage As String)
Dim Rg As Range
Set Rg = Worksheets(Feuille).Range(RgImage.Address)
    With Rg
        Largeur = .Offset(, 1)(, .Columns.Count).Left - .Left
        Hauteur = .Offset(.Rows.Count).Top - .Item(1).Top
        Set Image = Worksheets(Feuille).Pictures.Insert(NomImage)
    End With
    With Image
        .Left = Rg.Left
        .Top = Rg.Top
        'Largeur de l'image
        Image.Width = Largeur
        'Hauteur de l'image
        Image.Height = Hauteur
        'Est-ce que l'image doit se déplacer avec les cellules
        'voici les 3 constantes possibles
        .Placement = xlFreeFloating 'or xlmove or xlMoveAndSize
        'Verrouillé ou pas
        .Locked = True 'or False
    End With
    Set Rg = Nothing

End Sub
'-------------------------------------------------------