c'est un truc que j'ai eu du mal à faire :
vous avez deux listes l'une pleine et l'autre vide .
l'idée c'est de permettre a l'utilisateur de faire basculer des element d'une liste a l'autre grace a des boutons du genre ">", "<", "<<", ">>"
le probleme c'est qu'avec VBA et Access il n'y avait pas de additem ni de removeitem pour les listes ! (vous commencez a voir le probleme ?)
donc je l'ai fait, c'est bourrin mais ça marche !
si y'en a qui veulent l'ameliorer pas de pb !
soyez indulgents merci !
ah oui au fait c'est les procedures sub qui tournent derriere que je vous montre
donc si vous voulez tester faudra vous faire un formulaire access vous meme ! (dsl)
Source / Exemple :
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
Conclusion :
donc pour ceux qui ont eu le meme pb que moi avec vba et ces put1 de listes!
je pense que ça peut etre amelioré c'est pour ça que je le montre !
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.