UTILISER LES LISTES AVEC VBA ET ACCESS

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