Insertion une image automatiquement via lien externe

Marilo

XLDnaute Nouveau
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

XLDnaute Impliqué
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é...)


VB:
'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
'-------------------------------------------------------
 

Discussions similaires


Haut Bas