XL 2016 Liste déroulante avec image

[DUHAMEL59]

Bonjour
Je recherchais comment faire une liste déroulante avec image, j'ai trouvé un tableau excel déjà paramétré mais quand j'insère des nouvelles colonnes avant la B elle ne fonctionne plus.
en effet la colonne B se retrouve en D et quand je sélectionne soleil dans la liste déroulante l'image ne s'affiche plus et quand je la remet en B elle fonctionne.

Pourrez vous m'aider svp ?
Merci

 

[herve62]

Bonjour
Normal , dans ta sub la colonne Target est 2 donc B faut changer : 3 pour C 4 pour D ...etc à ton choix

 

[Rouge]

Bonjour,

Si vous insérez des colonnes avant la B, il faut modifier la ligne suivante:
If Target.Column = 2 And Target.Count = 1 Then
2 = colonne B
3 = colonne C, etc...

A vous de mettre le bon N° de colonne en fonction du nombre de colonnes ajoutées.

Cdlt

 

[DUHAMEL59]

Merci à Rouge et herve62, ça fonctionne merci !

 

[JohDan]

Bonjour
Je recherchais comment faire une liste déroulante avec image, j'ai trouvé un tableau excel déjà paramétré mais quand j'insère des nouvelles colonnes avant la B elle ne fonctionne plus.
en effet la colonne B se retrouve en D et quand je sélectionne soleil dans la liste déroulante l'image ne s'affiche plus et quand je la remet en B elle fonctionne.

Pourrez vous m'aider svp ?
Merci

Bonjour,

J'ai utilisé ce fichier pour modifier ma liste d'image, mais je n'arrive pas à transposer le tout dans mon fichier original (feuille 1 maintenant, dans le fichier joint). Je sais que je dois modifier la colonne et la ligne, mais comment arranger tout ça dans un tableau où il y a plusieurs colonnes qui requiert une image. (voir en rose). Je suis coincée là !

Au nombre de fiches de cadenassage que je dois faire, j'aimerais vraiment ne plus avoir à faire du copier-coller d'images à chaque fois. J'ai bien transposé mes images dans votre tableau et cela fonctionne super. mais comment l'adapter à mon fichier ? Fichier auquel j'ajoute ou enlève des lignes, selon le travail à faire.

Mon fichier est beaucoup plus volumineux, j'ai dû le réduire pour vous l'envoyer.

Pouvez-vous m'aider à l'adapter? Merci d'avance,

 

[JohDan]

Je joins une copie de mon fichier original pour que vous voyiez avec quoi les gars travaillent. Si je pouvais utiliser la liste existante, ce serait sans doute moins lourd, mais je n'attends pas des miracles loll

 

[herve62]

Bonsoir
Vu au début ou je suis intervenu , mais là dans ton cas l'exemple n'est plus adapté !!
J'ai fait d'autres appli pour insérer une image avec proportions respectées mais il fallait ouvrir l'explorateur ( qui s'ouvre sous vba !! ) et là on choisit l'image qui ensuite s'insère dans la cellule
faudrait rechercher mes "post" sur ce sujet .. de mémoire il y en a beaucoup
Là vite fait j'ai retrouvé un exemple , bon il y a un USF qui transmet mais tu peux le court -circuiter pour insérer direct feuille ( éplucher le code) , les sub sont super pour insérer des images , j'y avais passé Bcp de temps à l'époque

 

[patricktoulon]

Bonjour
en regardant le post 1 j'ai remarqué quelque chose et j'ai testé pour confirmer
en effet le sendkey déverrouille le pavé numérique (problème bien connu du sendkey de l'application)

passez plutôt par wscript.shell

Sub ClicImage()
 ActiveSheet.Shapes(Application.Caller).TopLeftCell.Select
 CreateObject("Wscript.shell").SendKeys "%{down}"
End Sub

pour les proportions respectées(lockaspectratio)

centrer une image dans un range en toute circonstances quel que soit le ratio (range/image) - Mises à jour

www.excel-downloads.com

 

[JohDan]

Hum je ne trouve pas ou je ne comprends pas vos réponses.

 

[patricktoulon]

re
Bonjour

j'insère des nouvelles colonnes avant la B elle ne fonctionne plus.
en effet la colonne B se retrouve en D et quand je sélectionne soleil dans la liste déroulante l'image ne s'affiche plus et quand je la remet en B elle fonctionne.

et ben dis donc c'est pourtant évident

dans le code de l'event change on lit ceci
If Target.Column = 2 And Target.Count = 1 Then

et donc si tu insère des colonnes avant la "B" ton event va agir sur la colonne qui se trouve etre maintenant le 2d ( faut pas sortir de st cyr pour comprendre ça )
il te faut donc que ce "2" soit dynamique
donc pour cela nous allons ajouter une variable public dans le module on l'appelera "colonne"
et cet variable sera déterminée dans la sub clic image a chaque clic
j'ai ajouté aussi ma fonction perso de placement image pour que l'image soit bien placée au centre de la cellule
DONC !!! :
l'event dans le module de la feuille ainsi que ma fonction

Private Sub Worksheet_Change(ByVal Target As Range)
  Set images = Sheets("logos")
  If Target.Column = colonne 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
        Selection.OnAction = "ClicImage"
        Selection.Name = "Image" & ActiveCell.Row
        PlaceTheShapeInCenterRange Target, ActiveSheet.Shapes("Image" & ActiveCell.Row), 10'10% de réduction
        Target.Select
      End If
    End If
   End If
End Sub

Sub PlaceTheShapeInCenterRange(rng As Range, shap, Optional marge As Long = 0)     'la marge exprime un pourcentage de 1 à x%
    Dim Ratio#
    Ratio = Application.Min(rng.Cells(1).MergeArea.Width / shap.Width, rng.Cells(1).MergeArea.Height / shap.Height)
    With shap
        .LockAspectRatio = True
        .Width = .Width * (Ratio * ((100 - marge) / 100))
        .Top = rng.Top + ((rng.Cells(1).MergeArea.Height - .Height) / 2)
        .Left = rng.Left + ((rng.Cells(1).MergeArea.Width - .Width) / 2)
    End With
End Sub

et maintenant le module standard et la sub clic image

Public colonne As Long'!!!!!!!!!
Sub ClicImage()
    With ActiveSheet.Shapes(Application.Caller).TopLeftCell
        colonne = .Column'on determine la variable public colonne
        .Select
        CreateObject("Wscript.shell").SendKeys "%{down}"
    End With
End Sub

et par pitié OUBLIEZ!!! le sendkeys par l'application ou vba , il cause la désactivation du pavé numérique passez plutôt par Wscript.shell

et voila dorénavant la colonne sera toujours identifiée au clic de l'image même si tu a inséré ou supprimé des colonnes

voyons voir

et voila tu a ta liste d'image cliquable et tu peux insérer ou supprimer autant de colonne que tu veux
a raison bien évidemment que la colonne des images soit au minimum la première bien sur
je joint le classeur au cas ou

 

[riton00]

Bonjour patricktoulon

Je déterre cet ancien post suite à un besoin personnel et après moult recherche je suis tombé sur ce lien que voici voir au post #10.
Sur le fichier joint j'ai mis un petit commentaire pour que tu puisses comprendre mon problème en espérant une explication
Merci de te lire
Slts

 

[patricktoulon]

Bonsoir @riton00
prend ton temps, assiez toi sur la chaise et dis moi si il manque pas quelque chose

Private Sub Worksheet_Change(ByVal Target As Range)
    Set images = Sheets("logos")
  If Target.Column = colonne And Target.Count = 1 Then
  '...
  '...
  '...'

tu va comprendre tout seul
trois fois rien il te manque

 

[patricktoulon]

re
allez je te le dit

Private Const colonne As Long = 2

Private Sub Worksheet_Change(ByVal Target As Range)
    Set images = Sheets("logos")
  If Target.Column = colonne And Target.Count = 1 Then

 

[riton00]

Re patricktoulon

Effectivement maintenant ça va tout seul merci beaucoup pour ce complément, ben! en faite j'ai copié le code du post#10 sans faire attention qu'il manquait

Private Const colonne As Long = 2

en tout les cas merci pour ton aide
Slts

 

[patricktoulon]