XL 2016 Liste déroulante avec image

DUHAMEL59

XLDnaute Nouveau
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
 

Pièces jointes

  • DVMeteoClicImage.xlsm
    46.7 KB · Affichages: 35

Rouge

XLDnaute Impliqué
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
 

JohDan

XLDnaute Nouveau
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,
 

Pièces jointes

  • Fichier-test.zip
    946.8 KB · Affichages: 21

JohDan

XLDnaute Nouveau
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
 

Pièces jointes

  • 001-Modèle - test.pdf
    185.6 KB · Affichages: 11

herve62

XLDnaute Barbatruc
Supporter XLD
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
 

Pièces jointes

  • Fichier Loulous.xlsm
    165.9 KB · Affichages: 16

patricktoulon

XLDnaute Barbatruc
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
VB:
Sub ClicImage()
 ActiveSheet.Shapes(Application.Caller).TopLeftCell.Select
 CreateObject("Wscript.shell").SendKeys "%{down}"
End Sub

pour les proportions respectées(lockaspectratio)
 

patricktoulon

XLDnaute Barbatruc
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
VB:
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

VB:
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

demo7.gif


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 ;)
 

Pièces jointes

  • DVMeteoClicImage Version Patricktoulon.xlsm
    48.4 KB · Affichages: 15
Dernière édition:

riton00

XLDnaute Impliqué
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
 

Pièces jointes

  • Essais.xlsm
    60.6 KB · Affichages: 1

patricktoulon

XLDnaute Barbatruc
Bonsoir @riton00
prend ton temps, assiez toi sur la chaise et dis moi si il manque pas quelque chose
VB:
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
demo.gif
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 924
Membres
101 841
dernier inscrit
ferid87