Problème sélection multiple dans listbox

  • Initiateur de la discussion Initiateur de la discussion vincejkt
  • 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 !

vincejkt

XLDnaute Nouveau
Bonjour,

j'ai créé une liste déroulante avec multiples sélections de choix. Jusque là tout va bien quand je clique dans l'une des cellules de la colonne D la liste apparaît et je peux cocher les options utiles. Mais là ça se corse, il n'y a que la deuxième option qui apparaît en plusieurs fois suivant le nombre coché . je ne comprends pas d'où vient le problème. Je précise que c'est ma première MACRO et que je ne suis pas un spécialiste, je me suis beaucoup aidé de tuto sur le net.

Si quelqu’un a la solution .... merci d'avance !!

voici mon code et le fichier :

Option Explicit
Dim i As Long
Dim stemp As String
Dim a
Dim btest As Boolean


Private Sub listbox1_change()
If btest Then
Exit Sub
End If
stemp = ""
For i = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(i) Then
stemp = stemp & Me.ListBox1.List(1) & Chr(10)
End If
Next
On Error Resume Next
Err.Clear
stemp = VBA.Left(stemp, VBA.Len(stemp) - 1)
If Err.Number <> 0 Then
stemp = ""
End If
On Error GoTo 0

ActiveSheet.Unprotect
ActiveCell = stemp

End Sub


Private Sub worksheet_SelectionChange(ByVal target As Range)
If ActiveCell.Column = 4 Then
With Me.ListBox1
.MultiSelect = fmMultiSelectMulti
.ListStyle = fmListStyleOption
.Height = 150
.Width = 150
.Top = ActiveCell.Top
.Left = ActiveCell.Offset(0, 1).Left
.Visible = True
End With
On Error Resume Next
'i = Application.WorksheetFunction.Match(Cells(ActiveCell.Row, 2), Worksheets("donnee").Range("familles"), 0) - 1
i = 0
If Worksheets("donnee").Range("A1").Offset(0, 1).End(xlDown).Row = 4 Then
Me.ListBox1.List = Array(Worksheets("donnee").Range(Worksheets("donnee").Range("A1").Offset(1, i), _
Worksheets("donnee").Range("A1").Offset(0, i).End(xlDown)).Value, "")
Else
Me.ListBox1.List = Worksheets("donnee").Range(Worksheets("donnee").Range("A1").Offset(1, i), _
Worksheets("donnee").Range("A1").Offset(0, i).End(xlDown)).Value
End If
On Error GoTo 0
a = VBA.Split(ActiveCell, Chr(10))
If UBound(a) >= 0 Then
For i = 0 To Me.ListBox1.ListCount - 1
If Not IsError(Application.Match(Me.ListBox1.List(i), a, 0)) Then
btest = True
Me.ListBox1.Selected(i) = True
btest = False
End If
Next
End If
Else
Me.ListBox1.Visible = False
End If
End Sub
 

Pièces jointes

- 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
3
Affichages
599
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
250
Réponses
4
Affichages
459
Retour