Discussion :

[grosquick59]

Bonjour,
j'ai créé un userform ou plutôt je me suis fait aider pour créer un userform avec listbox.
Je souhaite que le formulaire garde en mémoire les sélection. En d'autres termes je voudrais une préselection en fonction de ce qui se trouve dans la cellule.

Exemple
je sélectionne dans ma listbox :
AQ system
AQ operationnelle
LABO

il m'écrira dans la cellule demandée :
AQ system,AQ operationnelle,LABO

Si je reviens dans x jours et que j'écris dans cette cellule la même chose. En appelant ma listbox je voudrais que ces 3 paramètres soient préselectionné.

Est-ce que c'est possible selon vous ?


voici le code utilisé :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Private Sub CommandButton1_Click()
Dim i%, Texte$, Tb(), x%
'on boucle sur les items de la listbox
For i = 0 To ListBox1.ListCount - 1
    'si un item est sélectionné
    If ListBox1.Selected(i) Then
        'on l'ajoute à la variable texte séparé par une virgule
        Texte = Texte & ListBox1.List(i) & ", "
        'on redimensionne le tableau Tb
        x = x + 1
        ReDim Preserve Tb(1 To x)
        'et on lui ajoute l'item
        Tb(x) = ListBox1.List(i)
    End If
Next
's'il n'y a aucun item sélectionné on quitte
If x = 0 Then Exit Sub
'on écrit le texte dans la cellule active en supprimant la dernière virgule
ActiveCell = Left(T, Len(T) - 2)
'dans la feuille lettrediffusion
With Feuil2
    'on efface les anciennes données
    .Range("A12:A100").ClearContents
    'et on transfert les données du tableau Tb
    .Range("A12").Resize(UBound(Tb), 1) = Application.Transpose(Tb)
End With
Unload Me
End Sub

[bellande]

bonjour,

Voici quelques éléments en admettant que les éléments de liste soient les uns sous les autres. Un certain nombre de conditions est également nécessaire pour que ce code fonctionne bien.

Pour tester : on se place sur la première cellule contenant un élément de liste et on clique sur le bouton suivant. Les éléments de liste sont sélectionnés jusqu'à ce que l'on rencontre une cellule qui ne contient pas un élément de liste.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Private Sub CommandButton2_Click()
 
Dim i As Integer
Dim n As Integer
Dim Boolcontinuer As Boolean
 
i = 0
If ActiveCell.Value <> "" Then
  Do
    Boolcontinuer = False
    For n = 0 To ListBox1.ListCount - 1
       If ActiveCell.Offset(i, 0).Value = ListBox1.List(n) Then
         ListBox1.Selected(n) = True
         Boolcontinuer = True
       End If
    Next n
    i = i + 1
  Loop Until Boolcontinuer = False
End If
 
End Sub

[grosquick59]

merci bellande mais ça n'a pas l'air de fonctionner.
Comme je fais apparaître le formulaire en double cliquant j'ai essayé de bidouiller un peu la macro mais ça ne fonctionne pas tout à fait.
Peut-être que tu pourras m'aider ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 12 And Target.Row > 3 Then
    Cancel = True
 
    UserForm1.Show
' deselection de toute la liste
'    For x = 0 To UserForm1.ListBox1.ListCount - 1
'        If ListBox1.Selected(x) = True Then
'            UserForm1.ListBox1.Selected(x) = False
'        End If
'        If UserForm1.ListBox1.List(x) = ActiveCell Then
'            UserForm1.ListBox1.Selected(x) = True
'        End If
'    Next
 
End If
End Sub

[grosquick59]

Pour ceux que ça intéresse j'ai trouvé la réponse sur un autre forum.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Private Sub UserForm_Initialize()
Dim T, i%, x
ListBox1.List = [Secteurs].Value
If ActiveCell <> "" Then
    T = Split(ActiveCell, ",")
    For i = 0 To ListBox1.ListCount - 1
        x = Application.Match("*" & ListBox1.List(i) & "*", T, 0)
        If Not IsError(x) Then ListBox1.Selected(i) = True
    Next
End If
End Sub

A+