Utiliser les listes avec vba et access

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

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.