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

vincejkt

XLDnaute Nouveau
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),
 

vincejkt

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

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

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

XLDnaute Nouveau
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?
 

Discussions similaires

Réponses
4
Affichages
165

Statistiques des forums

Discussions
311 720
Messages
2 081 913
Membres
101 837
dernier inscrit
Ugo