Formulaire choix multiple

[grosquick59]

Bonsoir,
je souhaite avoir une liste à choix multiple facilement utilisable par plusieurs personnes n'ayant pas de connaissances poussées d'excel.
Un exemple de ce que je souhaite faire se trouve en pièce jointe.

explications du fichier joint :
2 feuilles :

feuille 1 "enregistrement"
feuille 2 "listediffusion"​

je souhaite sélectionner en J4 de la feuille 1 ("enregistrement") plusieurs secteurs pour la diffusion d'une procédure.
Je veux ensuite que ces secteurs se répartissent sur la feuille 2 ("listediffusion")dans une même colonne, sur plusieurs lignes.

Je suis parti sur un formulaire mais si vous avez d'autres solutions je suis preneur.
ça fait un moment que je bloque et là je sèche un peu.

Merci d'avance pour votre aide.


grosquick

 

[kjin]

Re : Formulaire choix multiple

Bonsoir,
Voir PJ avec ce que j'ai compris
A+
kjin

 

[grosquick59]

Re : Formulaire choix multiple

Salut kjin
merci pour ton aide. Le fichier que tu m'a transmis fonctionne mais j'ai un bug lorsque j'essaie de l'adapter à mon fichier complet.
Il m'indique une erreur 424 "objet requis"

J'ai un peu de difficultés à comprendre ton code. Comment tu fais pour appliquer à la feuille "listediffusion" ?
je n'arrive pas à comprendre dans le code que tu as fait.

tu pourrais m'expliquer un peu stp ?



[EDIT : 22 Mai 2011 22h50]
C'est ok j'ai compris. C'est super ce que tu as fait je n'avais pas penser à renommer la liste.
Merci ça fonctionne super.

bonne soirée

grosquick

 

[kjin]

Re : Formulaire choix multiple

Bonsoir,
Crées la plage nommée "Secteurs" au préalable

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

A+
kjin

 

[grosquick59]

Re : Formulaire choix multiple

Merci pour ta réponse.




grosquick

 

[grosquick59]

Re : Formulaire choix multiple

Bonjour,
Est-il possible de garder en mémoire les sélections ?

Je m'explique, je dois pouvoir faire apparaitre les secteurs précédemment indiqués pour vérifier et éventuellement modifier.

Aurrais-tu stp une solution à me proposer ?


grosquick

 

[grosquick59]

Re : Formulaire choix multiple

Hello,
quelqu'un aurait-il une solution ?

voici le code que j'ai modifié mais sans succès :

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

 

[kjin]

Re : Formulaire choix multiple

Bonsoir,
Dans le module du USF

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

 

[grosquick59]

Re : Formulaire choix multiple

Super !!
merci beaucoup

a+