Discussion :

[Cahlagan]

Bonjour à tous,

Je devrai élaborer plusieurs fichiers Excel, avec lesquels effectuer, en VBA, des opérations de base (filtrage et tri notamment). Or, depuis l'un de mes derniers messages, j'ai suivi le conseil de Philippe Tulliez, qui évoquait l'intérêt de passer par des tableaux structurés... ce que je ne connaissais pas. C'est effectivement très pratique, plus besoin de passer par des formules pour gérer la taille du tableau! Mais j'ai tout de même quelques difficultés à élaborer mon fichier. Il est d'autant plus important qu'il servira de structure pour les fichiers à venir.

En gros, j'aimerais, pour chaque tableau structuré nommé, respecter certaines règles:
1) Utilisation des macros événementielles
2) Feuilles protégées sans mot de passe

et là où je bute:

3) Certaines colonnes seront filtrables (le doubleclic dans une cellule filtre les données OU les réaffiche toutes si un filtrage était déjà en cours dans la colonne)
4) Certaines colonnes seront triables (par doubleclic sur l'entête; un doubleclic trie de A à Z, un nouveau doubleclic sur l'entête trie dans l'autre sens. Un doubleclic sur une cellule effectue un filtrage)
5) Certaines colonnes seront filtrables et triables (lorsqu'un deuxième filtre s'applique, il ne doit pas effacer le premier, il s'ajoute au premier et s'applique seulement aux lignes affichées)
6) D'autres colonnes ne seront ni l'un ni l'autre

J'ai passé par ChatGPT, qui m'a proposé des solutions très proches de ce que je cherche... mais jamais tout à fait fiables, ou jamais tout à fait à 100%. Je cherchais quelque chose qui soit le plus simple possible. La possibilité d'indiquer, dans la macro et pour chaque fichier, les colonnes où interviendra le tri, le filtrage (ou les deux) m'intéresse beaucoup, car elle offre une structure de base où il ne me sera pas nécessaire de devoir tout réinventer à chaque fois. Voici, à titre d'exemple, les codes que l'IA m'a proposés:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
Private Sub Workbook_Open()
    Dim ws As Worksheet
    Dim tbl As ListObject
 
    ' Désactiver les événements et le rafraîchissement d'écran
    Application.EnableEvents = False
    Application.ScreenUpdating = False
 
    ' Déprotéger la feuille, désactiver les icônes de filtrage, puis reprotéger la feuille
    For Each ws In ThisWorkbook.Worksheets
        ws.Unprotect Password:=""
        For Each tbl In ws.ListObjects
            tbl.ShowAutoFilter = False
        Next tbl
        ws.Protect Password:="", UserInterfaceOnly:=True
    Next ws
 
    ' Réactiver les événements et le rafraîchissement d'écran
    'Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub
 
 
 
 
 
 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim tbl As ListObject
    Dim triableCols As Collection
    Dim filterableCols As Collection
    Dim col As Variant
 
    On Error GoTo EnableEvents
 
    Set triableCols = New Collection
    Set filterableCols = New Collection
 
    triableCols.Add 2 ' Colonne 2 dans le tableau structuré (B)
    triableCols.Add 11 ' Colonne 11 dans le tableau structuré (K)
 
    filterableCols.Add 2 ' Colonne 2 dans le tableau structuré (D)
    filterableCols.Add 3 ' Colonne 3 dans le tableau structuré (E)
    filterableCols.Add 4 ' Colonne 4 dans le tableau structuré (F)
    filterableCols.Add 5 ' Colonne 5 dans le tableau structuré (G)
 
    ' Définir le tableau structuré
    Set tbl = ActiveSheet.ListObjects("Rapports_médicaux")
    ' MsgBox "Début de Worksheet_BeforeDoubleClick"
 
    ' Désactiver les événements pour éviter les déclenchements récursifs
    Application.EnableEvents = False
 
    ' MsgBox "Avant de vérifier la cellule"
 
    ' Vérifier si le double-clic est sur une cellule pour filtrer
    If Not Intersect(Target, tbl.DataBodyRange) Is Nothing Then
        ' MsgBox "Double-clic sur une cellule dans la plage de données"
        For Each col In filterableCols
            ' MsgBox "Vérification de la colonne " & col & " contre la colonne cible " & (Target.Column - tbl.Range.Column + 1)
            If (Target.Column - tbl.Range.Column + 1) = col Then
                ' MsgBox "La cellule est dans les colonnes filtrables"
                ' Vérifier si la colonne est déjà filtrée
                If Not tbl.AutoFilter Is Nothing Then
                    If tbl.AutoFilter.Filters.Count >= col And tbl.AutoFilter.Filters(col).On Then
                        ' MsgBox "Réinitialisation du filtrage pour la colonne"
                        RéinitialiserFiltrageColonne CInt(col)
                    Else
                        ' MsgBox "Application du filtrage exact"
                        ' Appliquer le filtre exact
                        FiltreExact CInt(col), Target.Value, True
                    End If
                Else
                    ' MsgBox "Application du filtrage exact"
                    ' Appliquer le filtre exact
                    FiltreExact CInt(col), Target.Value, True
                End If
 
                Cancel = True
                GoTo EnableEvents
            End If
        Next col
        ' MsgBox "Colonne non trouvée dans les colonnes filtrables"
        GoTo EnableEvents
    End If
 
    ' MsgBox "Avant de vérifier l'en-tête"
 
    ' Vérifier si le double-clic est sur l'en-tête pour trier ou réinitialiser
    If Not Intersect(Target, tbl.HeaderRowRange) Is Nothing Then
        For Each col In triableCols
            ' MsgBox "Vérification de la colonne triable " & col & " contre la colonne cible " & (Target.Column - tbl.Range.Column + 1)
            If (Target.Column - tbl.Range.Column + 1) = col Then
                ' MsgBox "L'en-tête est dans les colonnes triables"
                TriColonne CInt(col)
                Cancel = True
                GoTo EnableEvents
            End If
        Next col
 
        For Each col In filterableCols
            ' MsgBox "Vérification de la colonne filtrable " & col & " contre la colonne cible " & (Target.Column - tbl.Range.Column + 1)
            If (Target.Column - tbl.Range.Column + 1) = col Then
                ' MsgBox "L'en-tête est dans les colonnes filtrables"
                RéinitialiserFiltrage
                Cancel = True
                GoTo EnableEvents
            End If
        Next col
        ' MsgBox "Aucune colonne correspondante trouvée dans les en-têtes"
        GoTo EnableEvents
    End If
 
    ' MsgBox "Après vérification de l'en-tête"
 
EnableEvents:
    ' Réactiver les événements
    Application.EnableEvents = True
End Sub
 
 
 
 
 
 
Sub RéinitialiserFiltrage()
    Dim tbl As ListObject
    Dim cell As Range
 
    ' Définir le tableau structuré
    Set tbl = ActiveSheet.ListObjects("Rapports_médicaux")
    ' MsgBox "Début de la réinitialisation du filtrage"
 
    ' Afficher toutes les lignes du tableau
    Application.ScreenUpdating = False
    For Each cell In tbl.ListColumns(1).DataBodyRange
        cell.EntireRow.Hidden = False
    Next cell
    Application.ScreenUpdating = True
    ' MsgBox "Filtrage réinitialisé"
End Sub
 
Sub RéinitialiserFiltrageColonne(colIndex As Integer)
    Dim tbl As ListObject
    Dim cell As Range
    Dim otherFilters As Collection
    Dim col As Variant
 
    ' Définir le tableau structuré
    Set tbl = ActiveSheet.ListObjects("Rapports_médicaux")
    Set otherFilters = New Collection
 
    ' MsgBox "Début de la réinitialisation du filtrage pour la colonne " & colIndex
 
    ' Trouver les autres colonnes qui sont filtrées
    For col = 1 To tbl.ListColumns.Count
        If col <> colIndex Then
            If tbl.AutoFilter.Filters(col).On Then
                otherFilters.Add col
            End If
        End If
    Next col
 
    ' Afficher toutes les lignes du tableau pour la colonne spécifiée
    Application.ScreenUpdating = False
    tbl.Range.AutoFilter Field:=colIndex
    For Each cell In tbl.ListColumns(colIndex).DataBodyRange
        cell.EntireRow.Hidden = False
    Next cell
 
    ' Réappliquer les filtres des autres colonnes
    For Each col In otherFilters
        tbl.Range.AutoFilter Field:=col, Criteria1:=tbl.AutoFilter.Filters(col).Criteria1
    Next col
 
    Application.ScreenUpdating = True
    ' MsgBox "Filtrage de la colonne réinitialisé"
End Sub
 
Sub FiltreExact(colIndex As Integer, filtreValeur As String, Optional filtreVisibleSeulement As Boolean = False)
    Dim tbl As ListObject
    Dim cell As Range
    Dim found As Boolean
    Dim cellValue As String
 
    ' Définir le tableau structuré
    Set tbl = ActiveSheet.ListObjects("Rapports_médicaux")
    ' MsgBox "Début du filtrage exact sur la colonne " & colIndex
 
    ' Appliquer le filtrage exact
    Application.ScreenUpdating = False
    found = False
    For Each cell In tbl.ListColumns(colIndex).DataBodyRange
        If Not filtreVisibleSeulement Or cell.EntireRow.Hidden = False Then
            cellValue = cell.Value
            ' MsgBox "Comparaison de la valeur de la cellule: " & cellValue & " avec la valeur du filtre: " & filtreValeur
            If cellValue = filtreValeur Then
                cell.EntireRow.Hidden = False
                found = True
            Else
                cell.EntireRow.Hidden = True
            End If
        End If
    Next cell
    Application.ScreenUpdating = True
    If found Then
        ' MsgBox "Filtrage appliqué"
    Else
        ' MsgBox "Aucune correspondance trouvée"
    End If
End Sub
 
Sub TriColonne(colIndex As Integer)
    Dim tbl As ListObject
    Dim currentOrder As XlSortOrder
 
    ' Définir le tableau structuré
    Set tbl = ActiveSheet.ListObjects("Rapports_finaux")
    ' MsgBox "Début du tri sur la colonne " & colIndex
 
    ' Déterminer l'ordre de tri actuel
    If tbl.Sort.SortFields.Count > 0 Then
        If tbl.Sort.SortFields(1).Order = xlAscending Then
            currentOrder = xlDescending
        Else
            currentOrder = xlAscending
        End If
    Else
        currentOrder = xlAscending
    End If
 
    ' Effectuer le tri sur la colonne spécifiée
    tbl.Sort.SortFields.Clear
    tbl.Sort.SortFields.Add Key:=tbl.ListColumns(colIndex).Range, _
                            SortOn:=xlSortOnValues, Order:=currentOrder, DataOption:=xlSortNormal
 
    With tbl.Sort
        .Header = xlOui
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ' MsgBox "Tri effectué"
End Sub

Sur cette macro, Excel affiche une erreur 91 à la ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If tbl.AutoFilter.Filters.Count >= col And tbl.AutoFilter.Filters(col).On Then

Tous les msgbox (désactivés) m'ont servi à identifier où se situaient les problèmes.

Merci d'avance pour toute aide que vous pourriez m'apporter!

[Cahlagan]

Je vois que j'ai fait une erreur: le tableau s'appelle Rapports_finaux (C8:M123, la ligne 7 étant réservée aux en-têtes)

[Cahlagan]

Excusez-moi, dernière précision: un doubleclic en colonne E, par exemple, effectue un filtrage (Excel n'affiche que les lignes avec la valeur sur laquelle l'utilisateur a doublecliqué, ou réaffiche tout si un filtrage était en cours). Un doubleclic en colonne F effectue un nouveau filtrage, parmi les lignes affichées.

Mais, et c'est ce que n'arrive pas à faire ChatGPT, si je doubleclique sur une cellule en colonne E, Excel doit enlever tout filtre pour cette colonne-là, et cette colonne-là seulement! Désolé pour la longueur, mais je voulais être le plus clair possible

[laurent_ott]

Bonjour,
Pour répondre à certains de vos besoins je vous propose l'approche ci-dessous expliquée avec cette image :



De "A" à "H" le tableau structuré nommé [TS_Eleves], où je veux classer par ordre croissant ou décroissant les noms de famille et prénoms et ôter le filtre des notes en cliquant sur les en-têtes respectifs.
J'ai créé en "J:L" un second tableau [Tableau_Tri], que vous masquerez par la suite, qui reprend en "J1" la cellule "Nom Famille". Cette cellule est nommée "Nom_Famille" via le menu "Formules \ gestionnaire des noms". Idem pour le prénom en "K1" nommé "Prénom" et la note en "L1" nommée "Note".
Puis en "A1" j'ai inséré un lien : clic droit / liens / Emplacement dans ce document / Noms définis = Nom_Famille. (Astuce : modifiez l'info bulle par "Trier" pour ne pas voir afficher un vilain texte quand la souris pointe la cellule).
A quoi ça sert ?
Lorsque vous cliquez sur la cellule "A1"le lien vous redirige vers "J1" qui est sélectionnée. Il ne reste plus qu'a faire un événement "Sur changement de sélection". Si "J1" est sélectionné alors on trie les noms de famille soit par ordre croissant si J2=-1 ou décroissant dans le cas contraire. Et l'on renseigne "J2" du nouveau tri.
Si "K1" est sélectionné, même principe sur la colonne des prénoms.
Si "L1" est sélectionné on supprime le filtre de la colonne des notes.

Ci-dessous le code de l'événement. Les fonctions utilisées sont expliquées dans cette documentation : Fonctions pour gérer les Tableaux Structurés

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
'------------------------------------------------------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'------------------------------------------------------------------------------------------------------
 
If Target.Address = Range("Nom_Famille").Address Then
    If TS_InfoCellule([Tableau_Tri], "Nom Famille", 1) = -1 Then
        Call TS_TrierUneColonne([TS_Eleves], "Nom Famille", xlSortOnValues, xlAscending)
        Call TS_ModifCellule([Tableau_Tri], "Nom Famille", 1, 1)
    Else
        Call TS_TrierUneColonne([TS_Eleves], "Nom Famille", xlSortOnValues, xlDescending)
        Call TS_ModifCellule([Tableau_Tri], "Nom Famille", 1, -1)
    End If
    [TS_Eleves].ListObject.HeaderRowRange([TS_Eleves].ListObject.ListColumns("Nom Famille").Index).Select
End If
 
If Target.Address = Range("Prénom").Address Then
    If TS_InfoCellule([Tableau_Tri], "Prénom", 1) = -1 Then
        Call TS_TrierUneColonne([TS_Eleves], "Prénom", xlSortOnValues, xlAscending)
        Call TS_ModifCellule([Tableau_Tri], "Prénom", 1, 1)
    Else
        Call TS_TrierUneColonne([TS_Eleves], "Prénom", xlSortOnValues, xlDescending)
        Call TS_ModifCellule([Tableau_Tri], "Prénom", 1, -1)
    End If
    [TS_Eleves].ListObject.HeaderRowRange([TS_Eleves].ListObject.ListColumns("Prénom").Index).Select
End If
 
If Target.Address = Range("Note").Address Then
    Call TS_Filtres_Effacer([TS_Eleves], "Note")
    [TS_Eleves].ListObject.HeaderRowRange([TS_Eleves].ListObject.ListColumns("Note").Index).Select
End If
 
End Sub
'------------------------------------------------------------------------------------------------------

Bonne continuation.

[Cahlagan]

Merci laurent_ott, mais c'est trop compliqué pour moi...
Je me rends compte que, finalement, ce que j'aimerais est assez simple à expliquer, mais beaucoup moins à réaliser. Sur les colonnes où le doubleclic doit s'appliquer, lors d'un doubleclic sur une cellule, Excel doit évaluer si des filtres sont déjà actifs POUR CETTE COLONNE-LA SEULEMENT. S'il n'y en a pas, il récupère la valeur de la cellule doublecliquée et n'affiche que les lignes contenant cette valeur. Si un filtre est déjà actif, Excel l'enlève.

Si je passe à une colonne adjacente, Excel doit fonctionner pareil. S'il filtre des données, il doit le faire uniquement sur les cellules affichées (et pas sur celles qui ont été masquées avec un premier filtre). C'est là que l'IA bute: soit elle annule tous les les filtres, soit ils ne fonctionnent pas

[laurent_ott]

Ca pourrait ressembler à cela :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
'------------------------------------------------------------------------------------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'------------------------------------------------------------------------------------------------------
Dim r As Range, Colonne As Long, Ligne As Long
Set r = TS_CelluleActive(Range("TS_Eleves"), Colonne, Ligne)
If Not r Is Nothing Then
 
    If TS_Filtres_Existe([TS_Eleves], Colonne) = True Then
        Call TS_Filtres_Effacer([TS_Eleves], Colonne)
    Else
        Call TS_Filtres_Poser([TS_Eleves], Colonne, Target.Value)
    End If
 
    Cancel = True
 
End If
 
End Sub
'------------------------------------------------------------------------------------------------------