Problème sélection multiple dans listbox

[vincejkt]

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

 

[sousou]

Replace 1 par i dans cette ligne
stemp = stemp & Me.ListBox1.List(i) & Chr(10)

 

[vincejkt]

Merci beaucoup Sousou !!!

pour continuer ce post qui se terminerait trop vite , je te (vous) soumets une autre problématique, j'ai au moins une (mais surement plus) autre colonne où je dois faire fonctionner une liste similaire. Je pensais utiliser les mêmes lignes de code (copier / coller de l’ensemble )en changeant juste les colonnes et en passant sur une listbox2 mais ça me crée des erreurs. Je pensais donc adapter cette ligne mais ça ne fonctionne pas non plus :

'i = Application.WorksheetFunction.Match(Cells(ActiveCell.Row, 2),

 

[sousou]

Envoi le fichier avec une autre colonne de ce type

 

[vincejkt]

elle existe déjà dans le fichier en PJ de mon premier post. il y a 2 feuilles sur celle "donnée" il y a tout.

 

[sousou]

Pour moi il n'y a pas d'info sur les colonnes que tu souhaites traiter de la même mainère que la colonne d

 

[vincejkt]

J'avais pas compris sorry.
Voilas ce que j'ai fait ..... pas brillant

 

[sousou]

Désolé, mais je ne vois pas ce que tu veux faire de plus.
est-ce sur la colonne hors contrat??

 

[sousou]

Je crois que j'ai compris,
regarde tu vas voir que ce n'est pas compliqué Une seule macro une seule listbox

 

[vincejkt]

bonjour Sousou ,

merci ! merci ! merci !

par contre tu as vachement simplifié le code !
J'ai donc cherché à comprendre et si je comprends bien je peux rajouter un :

Or target.Column =

pour une nouvelle colonne avec listebox1.

De plus je vois que tu utilises :

Set liste = ThisWorkbook.Names("dc").RefersToRange

pour dire quelle liste d'option utiliser. Mais je ne vois pas comment ("dc") peut apparaître comme une valeur correcte à la place de :

Worksheets("donnee").Range("A1").

Peux tu m'expliquer le mécanisme ? j'abuse peut être ? sorry

 

[vincejkt]

C'est bon j'ai compris comment "dc" est une zone nommé (gestionnaire de non).
La seul chose que j'ai perdu c'est la capacité a ajouter (ou enlever) des lignes d'option sans a avoir a faire autre chose. La il faut modifier les cellules qui son dans la zone pas dramatique mais plus pratique.

 

[sousou]

Il suffit d'insérer une cellule dans ta liste, pas en dessous, mais par exemple en avant dernier (excel prendra en charge de modifier la taille de la zone, ou si tu veux la mettre en dessous, tu allonges zone nommée avec une ligne de plus vide.

 

[vincejkt]

Oui tous bêtement

 

[vincejkt]

Bonjour Sousou,

Je viens de me rendre compte d'une chose, les options ne restent pas cochées lorsque que l'on sort de la cellule. C'est assez contraignant lorsqu'il faut rajouter une nouvelle option en cours de route et que du coup il faut retrouver les options précédentes.
As tu une solution?

 

[sousou]

Bonjour
Méthode peut-être pas élégante, mais!
ajouter un flag pour désactiver l'évènement change quant ont récupère les données