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!