Tri personnalisé

Tri personnalisé sur formulaire en affichage continu

L'exemple ci-dessous suppose 3 zones de listes modifiables : lstA, lstB et lstC, ainsi que trois cases à cocher pour le choix descendant de chaque liste: chkA, chkB et chkC, le tout placé dans l'entête d'un formulaire avec affichage en mode continu.

On y placera également un bouton pour annuler les tris: cmdOderOff.

Dans l'événement "Sur chargement" du formulaire, on écrira :

Private Sub Form_Load()
    Dim vField As Variant
    Dim f As Field
    
    '/ Lire le nom des champs
    With Me.RecordsetClone
        For Each f In .Fields
            vField = vField & f.Name & ";"
        Next
    End With
    
    '/ Initialiser les case à chocher
    Me.chkA = False
    Me.chkB = False
    Me.chkC = False
    
    '/ Alimenter les listes
    lstA.RowSourceType = "Liste valeurs"
    lstA.RowSource = Left(vField, Len(vField) - 1)
    lstB.RowSourceType = "Liste valeurs"
    lstB.RowSource = Left(vField, Len(vField) - 1)
    lstC.RowSourceType = "Liste valeurs"
    lstC.RowSource = Left(vField, Len(vField) - 1)
End Sub

Pour le bouton annulation du tri :

Private Sub cmdOrderOff_Click()
    With Me
        '/ Supprimer le filtre
        .OrderBy = ""
        .OrderByOn = False
        '/ Supprimer les sélections
        .lstA = ""
        .lstB = ""
        .lstC = ""
    End With
End Sub

Sur "Après mise à jour" des listes, on appelera la fonction.

Ici l'exemple pour la liste lstA:

Private Sub lstA_AfterUpdate()
    OrderMyForm
End Sub

Même chose sur "Après mise à jour" des cases à cocher. Ici l'exemple pour la case à cocher "chkA":

Private Sub chkA_AfterUpdate()
    OrderMyForm
End Sub

Il reste à ajouter la fonction qui réalisera les tris :

Function OrderMyForm()
    Dim sOrder As String
    
    '/ Construire la liste
    If Not IsNull(Me.lstA) Then
        If chkA Then
            sOrder = Me.lstA & " DESC,"
        Else
            sOrder = Me.lstA & ","
        End If
    End If
    If Not IsNull(Me.lstB) Then
        If chkB Then
            sOrder = sOrder & Me.lstB & " DESC,"
        Else
            sOrder = sOrder & Me.lstB & ","
        End If
    End If
    If Not IsNull(Me.lstC) Then
        If chkC Then
            sOrder = sOrder & Me.lstC & " DESC,"
        Else
            sOrder = sOrder & Me.lstC & ","
        End If
    End If
    
    '/ Activer le tri
    If Len(sOrder) > 0 Then
        Me.OrderBy = Left(sOrder, Len(sOrder) - 1)
        Me.OrderByOn = True
    End If
    
End Function