Utiliser les listes avec vba et access
Soyez le premier à donner votre avis sur cette source.
Snippet vu 10 180 fois - Téléchargée 30 fois
Contenu du snippet
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)
je pense que ça peut etre amelioré c'est pour ça que je le montre !
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 SubConclusion :
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 !
A voir également
- Utiliser les listes avec vba et access
- Problème de liste sous VBA Access ✓ - Forum - Visual Basic 6
- Remplir une table par un recordset en utilisant une boucle en VBA-Access ✓ - Forum - Visual Basic
- Vba et access 2002 : erreur lors de l'utilisation du recordset ✓ - Forum - Visual Basic
- Vba ado access - Conseils pratiques - Visual Basic / VB.NET
- Liste code vba - Guide
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
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
- Messages postés
-
20
- Date d'inscription
- jeudi 1 avril 2004
- Statut
- Membre
- Dernière intervention
- 29 août 2004
1ç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 !
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!!!! :)
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.