Liste déroulante avec image

[stef2cr]

RE-bonjour,

Est-ce qu'il est possible de créer une liste déroulante en sélectionnant d'avoir le choix entre 3 images ?

J'ai essayé mais en vain.

[BOISGONTIER]

Bonsoir,

http://boisgontierjacques.free.fr/fi...esInternes.xls
http://boisgontierjacques.free.fr/fi...erraillage.xls

JB

[stef2cr]

Merci je regarde ça.
Je connais rien en vba

[Boby71C]

Bonsoir
Merci Boisgontier pour cette superbe réalisation.
C'est incroyable, je me posais la question il y a environ 1H00 pour réaliser ce genre de liste.

Pourrais tu me dire ou tu as trouver les petits panneaux, car il m'en manque quelques un pour réaliser mon fichier.

Merci
@+

[Boby71C]

Bonjour
J'ai trouvé de nouvelles images sur le net, j'ai bien agrandis la liste de validation en fonction de ces rajouts, mais lorsque je sélectionne mes nouvelles données, il y a un bug que je n'arrive pas à comprendre dans le code

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column = 8 And Target.Count = 1 Then
    '-- suppression
    For Each s In ActiveSheet.Shapes
      If s.Type = 13 Then
        If s.TopLeftCell.Address = Target.Offset(0, 1).Address Then
          s.Delete
        End If
      End If
    Next s
    '--
    If Target <> "" Then
        Sheets("Images").Shapes(Target).Copy
        Target.Offset(0, 1).Select
        ActiveSheet.Paste
        Selection.ShapeRange.Left = ActiveCell.Left + 7
        Selection.ShapeRange.Top = ActiveCell.Top + 5
        Target.Select
     End If
  End If
End Sub

Pouvez vous m'aider à comprendre s'il vous plait
Merci

@+

[phlaurent55]

Bonjour Boby,

es-tu sûr de la correspondance orthographique exacte des noms des dessins et des noms de la liste déroulante

ou alors joint ton fichier

à+
Philippe

[Boby71C]

Bonjour Philippe
Merci pour ton aide
Il s'agit du fichier de Boisgontier qui est situé ci dessus.
J'éssaie de l'adapter à mes besoins.
Entre ma question, et ta réponse, j'ai réussis à adapter en incorporant le code du second fichier de Boisgontier que je remercie à nouveau, et j'espère qu'il ne m'en voudra pas de le modifier.
Mon seul dernier souci, est que j'ai une zone intitulée "RAS" et qui, si je sélectionne cette donnée, va me chercher le dernier panneau en vigueur !!

J'aimerais comprendre le code pour l'adapter à mon besoin, surtout si j'ai plus ou moins de colonnes que le fichier joint.
Y a t'il également une solution pour que les panneaux se centrent automatiquement dans la colonne I de la feuille "Choix"
Solution trouvée pour centrer dans la colonne. Merci

Merci pour ton aide
@+

[phlaurent55]

Re,

ton fichier en retour avec explication de l'astuce dans la feuille "Images"

concernant le centrage, j'ai remplacé

    Selection.ShapeRange.Left = ActiveCell.Left + 7

par

    Selection.ShapeRange.Left = ActiveCell.Left + 30

à+
Philippe
.

[BOISGONTIER]

Bonjour,

Voir PJ

JB

[Boby71C]

Bonjour à tous
Merci pour vos réponses et votre patience.

Pour ne pas mourir bête, vous serait il possible de m'expliquer le code utilisé ?
car copier un code, c'est bien, mais le comprendre est encore mieux

Merci
@+

[BOISGONTIER]

Utiliser la touche F8 pour pas à pas et placer le curseur sur les variables pou observer la valeur.

Private Sub Worksheet_Change(ByVal Target As Range)
  Stop     ' pour test   appuyer sur f8 pour pas à pas
  If Target.Column = 8 And Target.Count = 1 Then
  '-- suppression image existante dans la cellule
  For Each s In ActiveSheet.Shapes   ' parcours de toutes images de la feuille
     If s.Type <> 8 Then   ' on ne prend pas les zones de texte
      If s.TopLeftCell.Address = Target.Offset(0, 1).Address Then
         s.Delete
      End If
    End If
   Next s
   '--
   If Target <> "" Then
    lig =[liste].Find(Target, LookAt:=xlWhole).Row  'recherche du code choisi dans la liste
    col =[liste].Column + 1
    témoin = False                                ' y a t-il une image pour ce code ?
    For Each s In Sheets("Images").Shapes         ' parcours de toutes les images
      If s.TopLeftCell.Address = Cells(lig, col).Address Then
        largeurImage = s.Width
        témoin = True          ' on a trouvé une image pour le code
        s.Copy                 ' on copie l'image
      End If
    Next s
    If témoin Then
      Target.Offset(0, 1).Select
      ActiveSheet.Paste         ' collage presse papier
      Selection.ShapeRange.Left = ActiveCell.Left + ActiveCell.Width / 2 - largeurImage / 2
      Selection.ShapeRange.Top = ActiveCell.Top + 5
      Target.Select
    End If
   End If
  End If
End Sub

JB

[stef2cr]

Bonsoir,
Après avoir passé quelques temps à comprendre comment fonctionnait tout ça. J'aime pas les trucs tout fait (en cuisine c'est pareil). Je me suis donc penché un peu sur les macros, et le code pour comprendre un peu le fonctionnement.

Maintenant que j'intègre ça dans un classeur, tout fonctionne bien, mais si j'enregistre et ré ouvre ce classeur. La liste ne fonctionne plus
Va comprendre Charles !!!

Ça fait des heures que je suis dessus et pas moyen de savoir le pourquoi du comment.
Merci de votre aide.