Utiliser les listes avec vba et access

Soyez le premier à donner votre avis sur cette source.

Snippet vu 9 923 fois - Téléchargée 29 fois

Commenter

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)

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 !

A voir également

Ajouter un commentaire

Commentaires

Signaler
lluzie
Messages postés
5
Date d'inscription
mercredi 18 août 2004
Statut
Membre
Dernière intervention
27 octobre 2004
 -
Salut edrimor!
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!!!!
Signaler
lluzie
Messages postés
5
Date d'inscription
mercredi 18 août 2004
Statut
Membre
Dernière intervention
27 octobre 2004
 -
euh en fait.... j'étais un peu tête en l'air ce matin.... :)
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!!!! :)
Signaler
cs_edrimor
Messages postés
20
Date d'inscription
jeudi 1 avril 2004
Statut
Membre
Dernière intervention
29 août 2004
 1 -
ben de rien !
ç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 !
Signaler
leviet_94
Messages postés
17
Date d'inscription
mardi 6 février 2007
Statut
Membre
Dernière intervention
25 juin 2013
 -
slt
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
Signaler
leviet_94
Messages postés
17
Date d'inscription
mardi 6 février 2007
Statut
Membre
Dernière intervention
25 juin 2013
 -
bon j'ai réglé le probleme
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
S'inscrire maintenant

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.