[RESOLU] Liste à choix multiples sous Excel

  • Initiateur de la discussion Initiateur de la discussion thomasdu40
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

thomasdu40

XLDnaute Occasionnel
Bonjour,

J'ai récupéré ce code qui me convient parfaitement mais j'ai 2 problèmes avec celui-ci.

Le 1er souci concerne la sélection des noms dans la listebox qui s'affiche. En effet si je coche le 1er nom celui-ci ne s'affiche pas dans la cellule. Pourquoi ?

Le 2ème souci : je voudrai que les noms choisis dans cette liste s'inscrivent dans la derniere cellule vide de la colonne C du fichier ci-joint. Exemple : si la cellule C5 est complétée, les noms sélectionnés dans la listbox se mettront dans la cellule C6. Si C6 est complétée, les noms iront dans la cellule C7, etc... .

Le code est :
Code:
Private Sub CommandButton1_Click()
[C6].Select
For k = 1 To ListBox1.ListCount - 1
 If ListBox1.Selected(k) = True Then
 tx = IIf(tx = "", ListBox1.List(k), tx & Chr(10) & ListBox1.List(k))
 End If
Next
Application.EnableEvents = False
If xx <> "" And tx = "" Then ActiveCell.Value = xx
If xx = "" And tx <> "" Then ActiveCell.Value = tx
If xx <> "" And tx <> "" Then ActiveCell.Value = xx & Chr(10) & tx
If xx = "" And tx = "" Then ActiveCell.Value = ""
fin:
Application.EnableEvents = True
Unload UserForm1
End Sub

Private Sub CommandButton2_Click()
Unload UserForm1
End Sub

Private Sub ListBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = 30 Then Unload UserForm2
End Sub

Private Sub UserForm_Activate()
Me.ListBox1.List = Feuil1.[A1:A30].Value
  PauseTime = 1    ' Définit la durée.
    Start = Timer    ' Définit l'heure de début.
    Do While Timer < Start + PauseTime
        DoEvents    ' Donne le contrôle à d'autres processus.
    Loop
UserForm1.ListBox1.Enabled = True
ListBox1.SetFocus
End Sub
 

Pièces jointes

Dernière édition:
Re : Liste à choix multiples sous Excel

Bonjour thomasdu40,

Voici comment recopier les valeurs sélectionnées sur des lignes qui se succèdent.

Par contre, je n'ai pas bien compris à quoi servent les 4 lignes de condition (If xx .....) et je les ai mises en commentaires.

Espérant avoir répondu.

Cordialement.
 

Pièces jointes

Re : Liste à choix multiples sous Excel

Comme je souhaite que dans une cellule il y ai plusieurs noms (sélectionnés via la listbox) j'ai modifié le code (voir ci-dessous). Le problème c'est qu'avec ce code si je sélectionne plusieurs noms il les intègre tous dans la cellule MAIS il en copie d'autres dans les cellules suivantes.

Pouvez-vous m'indiquer où se trouve l'erreur dans ce code. Je rejoins le fichier avec le code ci-dessous.

Merci.
Code:
Private Sub CommandButton1_Click()

With Sheets("Plan Act")
For k = 0 To ListBox1.ListCount - 1
 If ListBox1.Selected(k) = True Then
    lg = .Range("C4").End(xlDown).Row + 1
    .Cells(lg, 3) = ListBox1.List(k)
    tx = IIf(tx = "", ListBox1.List(k), tx & Chr(10) & ListBox1.List(k))
  End If
Next
Application.EnableEvents = False
If xx <> "" And tx = "" Then ActiveCell.Value = xx
If xx = "" And tx <> "" Then ActiveCell.Value = tx
If xx <> "" And tx <> "" Then ActiveCell.Value = xx & Chr(10) & tx
If xx = "" And tx = "" Then ActiveCell.Value = ""
fin:
Application.EnableEvents = True
Unload UserForm1
End With
End Sub
 

Pièces jointes

Re : Liste à choix multiples sous Excel

RE thomasdu40,

J'avais cru comprendre que chaque option devait être écrite dans une cellule distincte. Pour les mettre dans une seule et même case, voici le code modifié :

Code:
Private Sub CommandButton1_Click()

With Sheets("Plan Act")
lg = .Range("C4").End(xlDown).Row + 1
For k = 0 To ListBox1.ListCount - 1
 If ListBox1.Selected(k) = True Then
    .Cells(lg, 3) = ListBox1.List(k)
    tx = IIf(tx = "", ListBox1.List(k), tx & Chr(10) & ListBox1.List(k))
  End If
Next
Application.EnableEvents = False
If xx <> "" And tx = "" Then ActiveCell.Value = xx
If xx = "" And tx <> "" Then ActiveCell.Value = tx
If xx <> "" And tx <> "" Then ActiveCell.Value = xx & Chr(10) & tx
If xx = "" And tx = "" Then ActiveCell.Value = ""
fin:
Application.EnableEvents = True
Unload UserForm1
End With
End Sub

Cordialement.
 
Re : Liste à choix multiples sous Excel

Merci pour ton aide.

Ok j'ai mis le code dans la feuille et après avoir cliqué sur la dernière cellule vide de la colonne C, il me copie tous les noms sélectionés dans la ListBox.

Par contre si je refais une autre sélection via la ListBox sans cliquer sur la dernière cellule vide de la colonne C, il m'écrase les données dans la cellule précédente. Pourquoi ? (je rejoins le fichier avec ton code).

Merci.
 

Pièces jointes

Re : Liste à choix multiples sous Excel

RE :

Essaie comme ceci, alors :

Code:
Private Sub CommandButton1_Click()

With Sheets("Plan Act")
lg = .Range("C4").End(xlDown).Row + 1
For k = 0 To ListBox1.ListCount - 1
 If ListBox1.Selected(k) = True Then
    .Cells(lg, 3).Select
    ActiveCell = ListBox1.List(k)
    tx = IIf(tx = "", ListBox1.List(k), tx & Chr(10) & ListBox1.List(k))
  End If
Application.EnableEvents = False
If xx <> "" And tx = "" Then ActiveCell.Value = xx
If xx = "" And tx <> "" Then ActiveCell.Value = tx
If xx <> "" And tx <> "" Then ActiveCell.Value = xx & Chr(10) & tx
If xx = "" And tx = "" Then ActiveCell.Value = ""
fin:
Application.EnableEvents = True
Next
Unload UserForm1
End With
End Sub

Cordialement.

PS : dans le cas suivant, les instructions "EnableEvents" ne sont d'aucune utilité.
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
2
Affichages
131
Réponses
3
Affichages
602
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
258
Retour