Liste déroulante à choix multiple Excel 2007

Voici le second fichier:
https://www.cjoint.com/?0kCrINae8RX

Salut,
J'ai fait une erreur et un oubli... Désolé.
1- l'oubli : Il faut changer la propriété MultiSelec de la listbox. Pour cela, va sous Visual Basic (ALT+F11 dans ton classeur), affiche ton userform (à gauche de l'écran : fenêtre projet/feuilles/double clic sur Userform1), sélectionne la listbox en cliquant dessus et dans la fenêtre propriétés, règle le Multiselec sur 1- fmMulitiSelecMulti
2- l'erreur : dans le code d'initialisation de l'userform :

Private Sub UserForm_Initialize()
Dim i As Integer, Derlig As Integer
ListBox1.Clear
Derlig = Sheets("Feuil1").Cells(65536, 9).End(xlUp).Row
    For i = 1 To Derlig
        ListBox1.AddItem Cells(i, 9).Value
    Next i    
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            ListBox1.Selected(i) = False
        End If
    Next i
End Sub

Les lignes en gras ne fonctionnent que si la liste est sur la même feuille... Donc à remplacer par :

Private Sub UserForm_Initialize()
Dim i As Integer, Derlig As Integer
ListBox1.Clear
With Sheets("Listes")
Derlig = .Cells(65536, 1).End(xlUp).Row
    For i = 1 To Derlig
        ListBox1.AddItem .Cells(i, 1).Value
    Next i
End With
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            ListBox1.Selected(i) = False
        End If
    Next i
    
End Sub

Tu as deux choix :
- Choix un : le + simple, mais celui qui comporte un défaut :
Tu décides de déclencher le lancement de l'UserForm dès qu'il y a double clic dans ta feuille, peu importe l'endroit. Le souci ici est que si un utilisateur double clic en F123, l'USF se lance...
- Choix deux : on définit préalablement une plage de cellules ou seulement dans cette plage se déclenchera l'USF au double clic.

Tout se passe dans le code de la feuille concernée. Donc :
Clic droit/Visualiser le code sur l'onglet de ta feuille "Lundi"
Tu obtiens ceci :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 
If Target.Address = "$B$4" Then 
    Target.Value = "" 
    Load UserForm1 
    UserForm1.Show 
End If 
End Sub

Choix un : code à modifier comme ceci :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 
    Target.Value = "" 
    Load UserForm1 
    UserForm1.Show 
End Sub

Le code se lance de toute ta feuille...

Choix deux : code à modifier comme ceci :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 
If Intersect(Target, Range("F1:F10")) Is Nothing Then 
 Exit Sub 
Else 
    Target.Value = "" 
    Load UserForm1 
    UserForm1.Show 
End If 
End Sub

Je pense que tu as vu que dans ce cas, le code ne se déclenchera que sur les cellules de la plage F1:F10...

Dans les deux cas, il est nécessaire de changer le code du bouton. En effet, il est clair que tu va double cliquer dans la cellule ou tu veux ton résultat. Donc cette cellule ne sera pas Range("C4"), mais la cellule active (ben oui si tu double clic dans une cellule elle devient la cellule active après le premier clic...). Cela se traduit en VBA au lieu de Range(machin) par : ActiveCell. Ton code de bouton (peu importe comment tu l'appelles ;-)) devient donc :

Private Sub MET_ICI_LE_BON_NOM_DU_BOUTON_Click() 
Dim i As Byte 
Dim ValeurARetourner As String 
    For i = 0 To ListBox1.ListCount - 1 
        If ListBox1.Selected(i) = True Then 
            ValeurARetourner = ValeurARetourner & ListBox1.List(i) & " & " 
        End If 
    Next i 
If ValeurARetourner = "" Then 
    MsgBox "Sélection obligatoire ou fermez avec la croix" 
    Exit Sub 
End If 
ActiveCell = Left(ValeurARetourner, Len(ValeurARetourner) - 3) 
ActiveCell.Offset(1, 0).Activate 
UserForm1.Hide 
Unload UserForm1 
End Sub

ps : j'ai amélioré le code du bouton pour obliger une sélection... teste le sans sélectionner de moyen de transport...

Tu dis...

Pendant que j'y suis, pourrais-je abuser de ton savoir ? oui ... ??

Pour étendre la macro à plusieurs case dans la colonne il faut que je bidouille le code, j'imagine. Ça serait trop simple d'étendre simplement aux cases adjacentes ...
3eme option je refait la même pour toutes les cases concernés (ce qui me semble pas très logique)

Pour le bouton, pas d'idée, il fonctionne super bien chez moi...
Tu as toujours ce code affecté au bouton? : (pour vérifier, va sous VBE et double clic sur le bouton)

Private Sub CommandButton1_Click()
Dim i As Byte
Dim ValeurARetourner As String
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            ValeurARetourner = ValeurARetourner & ListBox1.List(i) & " & "
        End If
    Next i
With Sheets("Lundi")
.Range("B4") = Left(ValeurARetourner, Len(ValeurARetourner) - 3)
.Range("B5").Activate
End With
UserForm1.Hide
Unload UserForm1
End Sub

2- tu veux étendre la macro à plusieurs cases? La moi pas comprendre toi... Le bouton sert à envoyer la(es) valeur(s) choisie(s) en B4 ;cf ligne : .Range("B4") = Left(ValeurARetourner, Len(ValeurARetourner) - 3)
Tu veux que cette valeur se retrouve ou? ou tu veux? dans une cellule que tu as choisit préalablement? dans une plage définie à l'avance (toujours la même)? dans une plage indéfinie?
tu dis...

J'ai tenté de faire la macro mais ça ne fonctionne pas chez moi....en fait j'y suis arrivé sauf lorsqu'il faut changer les codes car moi aussi la liste est dans une autre feuille.

Je préfère la garder sur la même feuille aussi...mais si j'indique la colonne ou se trouve ma lise de choix...il faut qu'il n'y ait pas d'autres valeur sur cette même colonne ou d'autres data qui n'a rien à vois avec ma liste.

puis je vous envoyer mon fichier ? je ne suis pas aussi doué que pijaku :-)

Bonjour,

Je suis toujours en galère et j'arrive pas à comprendre ce qui beug..
J'ai réussi à faire ma macro mais je ne sais pas comment changé ma liste...
et l'autre difficulté c'est que je dois attribué des points au choix des réponses....

Help ! si je peux transmettre mon fichier svp...car je dois le rendre à 12h00

Autant pour moi ... c'est moi qui avait fait un problème dans le copier/coller ---
toutes mes excuses, pas d'erreur dans le code

Eh ... je suis tout confus.

Rien de compliqué en fait: j'ai copié/collé le code de la feuille1 vers la feuille2 et ça marche.

pijaku, je sais pas si ton pseudo est bizarre ou si c'est moi qui l'interprète bizarrement, mais derrière ce sobriquet, se cache un vrai génie.

1- je ne comprends pas l'erreur de compilation... Ta ListBox s'appelle toujours ListBox1?

2- Pour que l'USF se déclenche sur tes feuilles Mardi, Mercredi ... Facile!!!
Clic droit sur l'onglet lundi / Visualiser le code. Tu copies le code qui apparait.
Sur la gauche, tu as la fenêtre Projet (si si je l'ai vu dans la copie d'écran!!!)
dedans le nom de chacune de tes feuilles.
Double clic sur chaque nom de feuille ou tu souhaites que cela fonctionne et colles le code dans chaque fenêtre...
Tu fermes VBE et tu testes... Enfin, si tu arrives à résoudre le problème 1-
Si tu ne le résouds pas, envoie moi ton fichier par mail (dans mon profil- pour y accéder cliques sur mon pseudo et fouille) ou s'il n'y a pas de données confidentielles, place le sur https://www.cjoint.com/ ou http://www.cijoint.fr/ et reviens ici coller le lien ainsi créé.

Salut,
Ben oui c'est ballot!!!!
En fait, il faudrait, pour ton cas, que la macro recherche dans les valeurs de la colonne C, les choix sélectionnés et renvoie la valeur contenue dans la cellule voisine col D.
Ca n'a rien à voir avec le sujet ici...
Bon 'dmettons...
Voici le code qui va te permettre de continuer :

Private Sub CommandButton1_Click()
Dim i As Byte
Dim ValeurARetourner As String
Dim Trouve As Range
Dim Valeur_cherchee As String
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            Valeur_cherchee = ListBox1.List(i)
            Set Trouve = Sheets("Feuil1").Columns(3).Cells.Find(What:=Valeur_cherchee, LookIn:=xlValues, lookat:=xlWhole)
                    If Trouve Is Nothing Then
                        MsgBox "Pas trouvé"
                    Else
                        ValeurARetourner = ValeurARetourner & Trouve.Offset(0, 1).Value & "; "
                    End If
            Set Trouve = Nothing
        End If
    Next i
Range("G13") = Left(ValeurARetourner, Len(ValeurARetourner) - 2)
Range("G15").Activate
UserForm1.Hide
Unload UserForm1
End Sub

Et ça, c'est cadeau, ça fait plaisir...

Merci beaucoup Pijaku, trés claire, trés precis, parfais pour un noob comme moi.
Que ferais-je sans des bonens ames comme toi.
Merci aussi a studio103 d'avoir posé la questions ;-)

Bonjour,
Essaye :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("L2:L36,N2:N36")) Is Nothing Then
    Exit Sub
ElseIf Intersect(Target, Range("L2:L36")) Is Nothing Then
    Target.Value = ""
    Load UserForm2
    UserForm2.Show
ElseIf Intersect(Target, Range("N2:N36")) Is Nothing Then
    Target.Value = ""
    Load UserForm1
    UserForm1.Show
End If
End Sub

Merci!

Je tournais autour en bidoullant dans le sens de vos codes mais je ne trouvais pas la solution!

Cela fonctionne à merveille!

Je dois faire la même chose mais avec 4 menus mais je n'arrive pas!
Voilà mon code:


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Intersect(Target, Range("AC6:AF2000")) Is Nothing Then
Exit Sub

ElseIf Intersect(Target, Range("AC6:AC2000")) Is Nothing Then
Target.Value = ""
Load UserForm3
UserForm3.Show

ElseIf Intersect(Target, Range("AD6:AD2000")) Is Nothing Then
Target.Value = ""
Load UserForm2
UserForm2.Show

ElseIf Intersect(Target, Range("AE6:AE2000")) Is Nothing Then
Target.Value = ""
Load UserForm3
UserForm3.Show

ElseIf Intersect(Target, Range("AF6:AF2000")) Is Nothing Then
Target.Value = ""
Load UserForm4
UserForm4.Show

End If
End Sub

BONJOUR,
Oui nous pouvons t'aider.
Mais pour cela, il nous faudrait tous les codes contenus dans les modules et tes userforms.
Le plus simple serait de nous faire une copie de ton fichier sans données confidentielles, au format excel 97-2003 (xls), et de nous la transmettre en passant par cjoint.com et revenir ici coller le lien fourni...

OK
C'est dans la feuille appelée "test" que j'essaie de lister automatiquement les adresses

http://cjoint.com/?AKDjGUBrLyb

Et pourtant ça fonctionne...!!! Double clic en C3, comme convenu.
Le souci était dans le code de l'UserForm. Lorsque tu travailles dans un bloc With End With, si tu veux associer un objet à l'objet du bloc, il faut mettre un point devant.
Ici tu avais ce code :

With Sheets(blabla)
    ListBox1.AddItem Cells(Blibli)
End With

Sans point devant, le Cells(Blibli) se rapporte à la feuille active...
J'ai donc remplacé par :

Private Sub UserForm_Initialize()
Dim i As Integer, Derlig As Integer
ListBox1.Clear
With Sheets("Liste_Commerces_Concession")
Derlig = .Cells(65536, 29).End(xlUp).Row
    For i = 1 To Derlig
        ListBox1.AddItem .Cells(i, 29).Value
    Next i
End With
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            ListBox1.Selected(i) = False
        End If
    Next i
End Sub

Ok le listing se fait , cependant je ne peux pas sélectionner et ajouter la modalité que je souhaite.. l'erreur d'execution "6" apparait tout le temps ...

Oui. Tu as des variables déclarées As Byte (maxi 255) et As Integer.
Remplace Integer et Byte par Long :

Private Sub CommandButton1_Click()
Dim i As Long
Private Sub UserForm_Initialize()
Dim i As Long, Derlig As Long

Ensuite tu as une erreur également dans le nom de la feuille (code du bouton), la restitution des données doit se faire dans la feuille test... :

Private Sub CommandButton1_Click()
Dim i As Long
Dim ValeurARetourner As String
    
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            ValeurARetourner = ValeurARetourner & ListBox1.List(i) & " & "
        End If
    Next i
With Sheets("Test")
    .Range("C3") = Left(ValeurARetourner, Len(ValeurARetourner) - 3)
    .Range("C4").Activate
End With
UserForm1.Hide
Unload UserForm1
End Sub

Bonjour,

Ce sujet commencant à dater un peu, je vous recommande de créer votre propre sujet dans ce forum. Cela attirera plus d'internautes pour vous aider.
Merci également de préciser davantage ce que vous voulez obtenir car là j'avoue ne pas avoir tout saisi.
Cordialement,

Bonjour pijaku,
J'ai suivi tes instructions et j'ai créé un nouveau sujet "Liste déroulante à choix multiples avec mémorisation pour ajout" --> aucun succès certainement parce que mon explication n'est pas très clair! et qu'en fait c'est + la suite de cette conversation.

En gros, j'ai créé une liste déroulante à choix multiples valide dans l'ensemble de mon tableau. C'est un tableau qui doit être rempli une première fois (base) puis des éléments doivent y être ajouté au fur et à mesure.
Problème : lorsque je double clic à nouveau sur une case dans laquelle la liste déroulante a déjà été utilisé et que je veux ajouter des éléments, ma première saisie disparaît, je ne peux donc plus visualiser les premiers éléments et je suis obligée de resaisir l'ensemble (anciennes et nouvelles données).
Un petit coup de main?
Merci d'avance

Bonjour pijaku.
Je vous remercie pour tout vos précieux conseils et tuto.
Pour ma part, je vous remercie du petit coup de pouce que vous voudrez bien me donner.
Dans mon classeur : la feuille 1 contient dans la colonne A, des données provenant de la Feuille 2 Colonne B. Toujours dans ma feuille 1, la Colonne B doit contenir des données provenant de la feuille 2 Colonne C.
J'ai suivi les infos qu vous indiqué sur le site. Lorsque je double clique dans la feuille 1 colonne A le formulaire s'ouvre et la liste de la feuille 2 Colonne B s'affiche. Quand je clique sur la feuille 1 colonne B, le formulaire s'ouvre mais rien ne s'affiche à l'intérieur.
J'aurai besoin d'une grande aide Car je Doit finaliser mon document demain soir.
Avec Un très grand remerciement pour votre aide. Je vous joins mon fichier : https://www.cjoint.com/?0LfbOn4ObjV
Freeba.

Bonjour Freeba.
trop tard?

Bonjour,

Il y a pas mal de petites choses qui ne vont pas.
Commençons.
Tu veux remplir une ListBox avec les données contenues dans la Feuil2 Colonne C.
Or, ta colonne est vide.....
remplit là, ça ira mieux.

Bonjour,

Je l'ai fait, mais le tableau prends en charge la colonne C dans le feuille 1. J'ai vérifié le code, j'ai bien mis "feuil2" lors que je double clique sur le bouton.

tableau prends en charge la colonne C dans le feuille 1
puis :
J'ai vérifié le code, j'ai bien mis "feuil2"
Ne te choque pas?

Bon.
Dis moi exactement ce que tu souhaites réaliser...

Je le répète, si tu veux ajouter une liste de choix pour pouvoir sélectionner ton département en I9, il te faut remplir la colonne C 'Departement" de la Feuil2. Non???

désolée, je n'ai jamais fait du VBA avant, alors j'ai du mal à identifier les points de blocage.

Ce que je cherche à faire c'est en effet pouvoir, pour chaque entreprise, sélectionner plusieurs régions, puis plusieurs départements, dans lesquelles elle serait présente.

J'ai justement ajoutée la liste des département en colonne C feuille 2. Mais quand je clique sur I9 en feuille 1 pour choisir mes départements, c'est la valeur de la colonne C en feuille 1 qui apparaissent. et j'ai vérifié le code, j'ai bien "feuill2". donc je ne sais pas quoi faire pour que les données soit sourcés en feuille 2. Est-ce plus clair ?

Merci de ta réponse (et patience...)

Merci de ta réponse (et patience...)
Pas de souci.

J'ai justement ajoutée la liste des département en colonne C feuille 2
Liste qui n'est pas dans le fichier joint, ce qui porte à confusion.
Comme je voulais y aller par étape, la 1ère étape est ... de saisir les données dans les feuilles.
Ceci étant fait, pourquoi s'affichent les données de la feuil1?
tout simplement parce que, si tu ne le précises pas dans le code, Cells(i, 3) fait référence aux cellules de la colonne C de ... la feuille active. Or ta feuille active est la feuil1.
Ton code :

Private Sub UserForm_Initialize()
Dim i As Integer, Derlig As Integer
ListBox1.Clear

Derlig = Sheets("Feuil2").Cells(65536, 3).End(xlUp).Row
    For i = 1 To Derlig
        ListBox1.AddItem Cells(i, 3).Value
    Next i
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            ListBox1.Selected(i) = False
        End If
    Next i
End Sub

est donc à remplacer par :

Private Sub UserForm_Initialize()
Dim i As Integer, Derlig As Integer
ListBox1.Clear
With Sheets("Feuil2")
    Derlig = .Cells(65536, 3).End(xlUp).Row
    For i = 1 To Derlig
        ListBox1.AddItem .Cells(i, 3).Value
    Next i
End With
'Ici on a supprimer une boucle inutile. Cette ligne suffit à ce que rien ne soit sélectionné
ListBox1.ListIndex = -1
End Sub

La suite sera donc :
"ça marche pour I9, mais pas pour les autres cellules de la colonne I... Pourquoi?"

Bonjour,

Je n'ai pas ouvert ton fichier, essaye d'abord d'adapter le code à ta situation et on constatera ensemble.
Tu dis avoir 3 listbox à retourner dans la même cellule.
Si c'est 3 listbox sont multi-sélection il faut, non plus boucler sur une seule listbox, mais sur les 3. Comme ceci :

Private Sub Valider_Click()
Dim i As Byte
Dim ValeurARetourner As String
    
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            ValeurARetourner = ValeurARetourner & ListBox1.List(i) & " & "
        End If
    Next i
    For i = 0 To ListBox2.ListCount - 1
        If ListBox2.Selected(i) = True Then
            ValeurARetourner = ValeurARetourner & ListBox2.List(i) & " & "
        End If
    Next i
    For i = 0 To ListBox3.ListCount - 1
        If ListBox3.Selected(i) = True Then
            ValeurARetourner = ValeurARetourner & ListBox3.List(i) & " & "
        End If
    Next i
With Sheets("PARC PRESSES")
.Range("B3") = Left(ValeurARetourner, Len(ValeurARetourner) - 3)
.Range("C3").Activate
End With
UserForm1.Hide
Unload UserForm1
End Sub

Merci pijaku c'est effectivement le morceau qu'il me manquait, je poste le fichier exemple juste au cas où qqn tomberait sur le sujet.

Il s'agit bien entendu d'un simple fichier exemple simplifié au maximum à adapter à son utilisation.


https://www.cjoint.com/c/EBekyZX5kBW

Si ça peut aider d'autre personne, j'ai finalement trouvé la solution, il suffit de supprimer les "Exit Sub" et ça marche.

Merci beaucoup Pijaku pour le tuto ! En étant novice j'ai pu suivre et ma liste maintenant marche nikel.