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