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