Problème sélection multiple dans listbox

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

  • recap contrat macro - Copie.xlsm
    41.7 KB · Affichages: 17

Discussions similaires

Réponses
4
Affichages
189

Statistiques des forums

Discussions
312 024
Messages
2 084 718
Membres
102 638
dernier inscrit
TOTO33000