0/5 (5 avis)
Snippet vu 10 376 fois - Téléchargée 31 fois
Private Sub ajout_sel_Click() Dim items As String Dim i As Long Dim j As Integer Dim cpt As Integer Dim cpt2 As Integer Dim tab_index(50) As Long cpt = 0 If Me.liste_disp.RowSource <> vide Then 'si la liste des indicateurs disponibles n'est pas vide If Me.liste_disp.ItemsSelected.Count <> vide Then 'si l utilisateur a pensé a selectionner des indicateurs If Me.liste_sel.RowSource = "" Then 'on ajoute les en-tetes de colonnes si elle ne sont pas déjà là Me.liste_sel.RowSource = Me.liste_disp.Column(0, 0) & ";" & Me.liste_disp.Column(1, 0) & ";" End If For i = 0 To Me.liste_disp.ListCount - 1 If Me.liste_disp.Selected(i) = True Then items = items & Me.liste_disp.Column(0, i) & ";" & Me.liste_disp.Column(1, i) & ";" 'on stocke la valeur de l index dans un tableau tab_index(cpt) = i cpt = cpt + 1 End If Next Me.liste_sel.RowSource = Me.liste_sel.RowSource & items 'on ajoute les lignes selectionnées aux precedentes j = 0 While tab_index(j) <> 0 'cette boucle sert à supprimmer les elements selectionnés dans la premiere liste suppr_elem tab_index(j), Me.liste_disp cpt2 = 0 'probleme : une fois un element supprimmé d une liste, l index des autres elements est decalé 'il faut donc décrementer les index contenus dans le tableau While tab_index(cpt2) <> 0 tab_index(cpt2) = tab_index(cpt2) - 1 cpt2 = cpt2 + 1 Wend j = j + 1 Wend End If End If End Sub Private Function suppr_elem(ind_elem As Long, l As ListBox) 'fonction utilisée pour la suppression d un element dans une liste donnée Dim i As Long Dim cpt As Integer Dim ro_so2 As String 'en fait on reecrit le rowsource (contenu) de la liste en ommettant l element choisi For i = 0 To l.ListCount - 1 If i <> ind_elem Then ro_so2 = ro_so2 & l.Column(0, i) & ";" & l.Column(1, i) & ";" End If Next l.RowSource = ro_so2 End Function Private Sub ajout_tous_Click() Dim items As String Dim deb As Integer If Me.liste_disp.RowSource <> vide Then 'on ne fait l ajout que lorsqu il y a des elements a ajouter If Me.liste_sel.RowSource = "" Then deb = 0 'si la liste de droite était vide, on ecrit les entetes de colonnes Else deb = 1 End If For i = deb To Me.liste_disp.ListCount - 1 items = items & Me.liste_disp.Column(0, i) & ";" & Me.liste_disp.Column(1, i) & ";" Next Me.liste_sel.RowSource = Me.liste_sel.RowSource & items Me.liste_disp.RowSource = vide 'on vide la premiere liste End If End Sub Private Sub Form_Load() 'A chaque chargement du formulaire, les listes sont remises a zero 'la liste de gauche est rempli au moyan d une requete Me.liste_disp.RowSourceType = "Table/Query" Me.liste_disp.RowSource = "sel_indi" Me.liste_sel.RowSource = "" 'tandis que la liste de droite est vidée Me.liste_disp.Requery liste_transfo 'puis la liste de gauche est transformée en liste de valeur Me.liste_sel.Requery End Sub Private Function liste_transfo() 'cette fonction permet de transformer la nature de la liste de gauche 'au lieu d etre lie a une requete, elle devient une liste de valeur, 'ce qui la rend plus facile a manipuler Dim str As String For i = 0 To Me.liste_disp.ListCount - 1 str = str & Me.liste_disp.Column(0, i) & ";" & Me.liste_disp.Column(1, i) & ";" Next Me.liste_disp.RowSourceType = "Value List" Me.liste_disp.RowSource = str End Function Private Sub suppr_sel_Click() 'cette procedure fonctionne avec le meme principe que la procedure ajout_sel_click() 'la seule difference est qu elle sert a deplacer les elements de droite a gauche au lieu de gauche a droite Dim items As String Dim i As Long Dim j As Integer Dim cpt As Integer Dim cpt2 As Integer cpt = 0 Dim tab_index(50) As Long If Me.liste_sel.RowSource <> vide Then If Me.liste_sel.ItemsSelected.Count <> vide Then If Me.liste_disp.RowSource = "" Then Me.liste_disp.RowSource = Me.liste_sel.Column(0, 0) & ";" & Me.liste_sel.Column(1, 0) & ";" End If For i = 0 To Me.liste_sel.ListCount - 1 If Me.liste_sel.Selected(i) = True Then items = items & Me.liste_sel.Column(0, i) & ";" & Me.liste_sel.Column(1, i) & ";" tab_index(cpt) = i cpt = cpt + 1 End If Next Me.liste_disp.RowSource = Me.liste_disp.RowSource & items j = 0 While tab_index(j) <> 0 suppr_elem tab_index(j), Me.liste_sel cpt2 = 0 While tab_index(cpt2) <> 0 tab_index(cpt2) = tab_index(cpt2) - 1 cpt2 = cpt2 + 1 Wend j = j + 1 Wend End If End If End Sub Private Sub suppr_tous_Click() 'cette procedure remet les listes a leur etats initials Me.liste_disp.RowSourceType = "Table/Query" Me.liste_disp.RowSource = "sel_indi" liste_transfo Me.liste_sel.RowSource = "" End Sub
30 juil. 2007 à 16:12
donc je mets la portion de code a changer pour ceux qui ont le meme probleme que moi
ce code remplace le code de EDRIMOR de la ligne 38 à 45 et de 161 à 167
While tab_index(j) <> 0
'cette boucle sert à supprimmer les elements selectionnés dans la premiere liste
suppr_elem tab_index(j), Me.Liste_disp
cpt2 = j
'probleme : une fois un element supprimmé d une liste, l index des autres elements est decalé
'il faut donc décrementer les index contenus dans le tableau à partir de l'élément supprimer
While cpt2 < cpt
tab_index(cpt2) = tab_index(cpt2) - 1
cpt2 = cpt2 + 1
Wend
j = j + 1
Wend
30 juil. 2007 à 15:18
je sais que sa fait longtemps que tu a poster ceci mais bon j'ai une question
j'ai une erreur en appliquant ton code lorsque je selectionne au moins 4 champs certains ne sont pas supprimé de la premiere liste
merci
29 août 2004 à 20:16
ça m'aurait étonné que mon code ne marche pas (pas que je me croies super balèze loin de là) parce que j'ai pu le faire fonctionner de mon côté donc ...
ravi d'avoir pu aider quelqu'un !
18 août 2004 à 11:49
Ton code est nickel. J'avais oublié de modifier les propriétés de ma liste en "liste valeurs".
Voili et encore merci, tu viens de m'enlever une épine du pied!!!! :)
18 août 2004 à 11:33
J'ai essayé ton code mais chez moi ça ne marche pas....
En fait c'est la copie dans "liste_sel" qui ne se fait pas...
Bref si je trouve le truc chez moi je te le fais savoir.
Merci pour ton code!!!!
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.