MenuS déroulantS pour insérer des images

Bonjour à tous et à toutes,

Voilà plusieurs heures que je me casse la tête (sans résultats) pour insérer dans plusieurs colonnes le même menu déroulant qui permettrai d'afficher des images. Mon soucis c'est que pour l'instant je n'arrive à afficher les images que dans la colonne A grâce à une procédure que j'ai récupéré sur un tutoriel, dans les autres colonnes seul le texte s'affiche...

J'ai inséré ce code dans VBA :

Private Sub Worksheet_Change(ByVal Target As Range)

Set images = Sheets("image1")

If Target.Column = 1 And Target.Count = 1 Then

'-- suppression

For Each s In ActiveSheet.Shapes

If s.Type = 13 Then

If s.TopLeftCell.Address = Target.Address Then s.Delete

End If

Next s

'--

If Target <> "" Then

On Error Resume Next

images.Shapes(Target).Copy

If Err = 0 Then

ActiveSheet.Paste

largeurImage = images.Shapes(Target).Width

HauteurImage = images.Shapes(Target).Height

Selection.ShapeRange.Left = ActiveCell.Left + ActiveCell.Width / 2 - largeurImage / 2

Selection.ShapeRange.Top = ActiveCell.Top + 5

Rows(Target.Row).RowHeight = HauteurImage + 10

Target.Select

End If

End If

End If

End Sub[/code]

Et cette formule :

=DECALER(image1!$A$2;;;NBVAL(image1!$A:$A)-1)

dans le gestionnaire de noms.

Quand les menus déroulants sont dans la première colonne, ils fonctionnent mais pas dans les autres or comme vous pouvez le voir dans le fichier j'aimerai que les mêmes menus puissent être utilisés dans différentes colonnes.

Dois-je modifier le code? Si oui comment car toutes mes tentatives ont été des échecs... Ou alors l'un de vous connaît-il une autre méthode pour que je puisse arriver à mes fins?

Je vous remercie par avance pour le temps que vous consacrerez à ma demande.

Bonjour,

Cette ligne de code :

If Target.Column = 1 And Target.Count = 1 Then

fait en sorte que seule la colonne est est visée (Target.Column = 1)

Tu peux utiliser une Select Case pour définir les colonnes que tu souhaites avoir comme cible :

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Count > 1 Then Exit Sub

    Select Case Target.Column
        Case 1 To 5 '<-- colonnes de A à E
            Set images = Sheets("image1")
            For Each s In ActiveSheet.Shapes
                If s.Type = 13 Then
                    If s.TopLeftCell.Address = Target.Address Then s.Delete
                End If
            Next s
            '--
            If Target <> "" Then
                On Error Resume Next
                images.Shapes(Target).Copy
                If Err = 0 Then
                    ActiveSheet.Paste
                    largeurImage = images.Shapes(Target).Width
                    HauteurImage = images.Shapes(Target).Height
                    Selection.ShapeRange.Left = ActiveCell.Left + ActiveCell.Width / 2 - largeurImage / 2
                    Selection.ShapeRange.Top = ActiveCell.Top + 5
                    Rows(Target.Row).RowHeight = HauteurImage + 10
                    Target.Select
                End If
            End If
    End Select

End Sub

Un immense merci Theze ! ! ! Cela fonctionne parfaitement