Image en fonction d'une liste déroulante

Bonjour le forum,

j'ai réussi à afficher une image dans une cellule en fonction d'une référence choisie dans une autre cellule.

Mais voilà, j'ai beaucoup de ligne, donc j'ai atitré un nom à chaque image (ADA,ADB,ADC .... ETC)

Dans mon gestionnaire de noms, j'ai creer autant de nom que deligne de mon tableau avec comme valeur :

=DECALER(BDDONNEES!$D$4;EQUIV('1MODELE'!$B$13;noms;0)-1;0)

Le $B$13 est modifié en B14, B15 ...etc à chaque ligne.

Y a t-il un moyen d'éciter cela ?

Merci à vous.

Je joins un fichier pour explication.

Cdt

Phil

Bonjour

A tester

Merci Banzai64, ça fonctionne bien !!

Je vois que tu es passé en macro.

2 petites choses stp, si celà ne te dérange pas.

1- peux tu me mettre des explications sur ta macro ?

2-J'avais créer un bouton efface avec une macro, par contre le fait d'effacer ne m'efface pas les dessin, il faudrait que tout ce remette à vide.

A l'avance je te remercie

Phil

rivate Sub Worksheet_Change(ByVal Target As Range)
Dim Sh As Shape
Dim Cel As Range, Kase As Range

  If Target.Count > 1 Then
    For Each Kase In Target
      Worksheet_Change Kase
    Next Kase
    Exit Sub
  End If
  If Not Intersect(Range("B13:B24"), Target) Is Nothing Then
    Application.ScreenUpdating = False
    For Each Sh In ActiveSheet.Shapes
      If Sh.Type = msoPicture Then
        If Sh.TopLeftCell.Row = Target.Row And Sh.TopLeftCell.Column = Target.Column + 2 Then
          Sh.Delete
          Exit For
        End If
      End If
    Next Sh
    If Target = "" Then Exit Sub
    With Sheets("BDDONNEES")
      Set Cel = .Columns("A").Find(what:=Target, LookIn:=xlValues, lookat:=xlWhole)
      If Not Cel Is Nothing Then
        For Each Sh In .Shapes
          If Sh.TopLeftCell.Row = Cel.Row And Sh.TopLeftCell.Column = Cel.Column + 3 Then
            Sh.Copy
            ActiveSheet.Paste Target.Offset(0, 2)
            With Selection
            'With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
              .ShapeRange.LockAspectRatio = msoFalse
              .Width = Target.Offset(0, 2).Width
              .Height = Target.Offset(0, 2).Height
              .Top = Target.Offset(0, 2).Top + (Target.Offset(0, 2).Height / 2) - .Height / 2
              .Left = Target.Offset(0, 2).Left + (Target.Offset(0, 2).Width / 2) - .Width / 2
            End With
            Exit For
          End If
        Next Sh
      Else
        MsgBox Target & " Inconnu"
      End If
    End With
    Target.Select
  End If
End Sub

En cherchant sur le forum, j'ai trouvé cette fonction :

Application.ScreenUpdating = True

Ceci répond à mon point n°2

Merci

Phil

Bonjour

flm22 a écrit :

peux tu me mettre des explications sur ta macro ?

Des commentaires dans le code

flm22 a écrit :

J'avais créer un bouton efface avec une macro, par contre le fait d'effacer ne m'efface pas les dessin, il faudrait que tout ce remette à vide.

Pour moi cela fonctionne, en appuyant sur le bouton, outre le fait que les données soient effacées, cela efface aussi les dessins

flm22 a écrit :

Application.ScreenUpdating = True

Cela rétablit juste le rafraichissement écran, aucune incidence sur l'effacement des formes

Merci beaucoup pour ces explications.

Bonne journée

Phil