Revue de code VBA - problème affichage filtre
Bonjour,
Je suis sur la finalisation de mon code pour un fichier de gestion de charge.
Voici le code (looooong ^^"):
Public nombredelignes As Long
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Application.ScreenUpdating = False
If nombredelignes < ActiveSheet.ListObjects("Tableau1").ListRows.Count Then 'Permet d'ajouter initiation à chaque insertion de ligne
nombredelignes = ActiveSheet.ListObjects("Tableau1").ListRows.Count
For Each r In Target.Rows
Cells(r.Row, "C") = "INITIATION"
Next
Else
If nombredelignes > ActiveSheet.ListObjects("Tableau1").ListRows.Count Then 'Permet de confirmer la suppression de la ligne
nombredelignes = ActiveSheet.ListObjects("Tableau1").ListRows.Count
If MsgBox("Etes-vous sûr de vouloir supprimer la ligne ?" & vbCrLf & "Attention toute validation est définitive, aucune re-modification de la ligne ne sera possible !", vbInformation + vbYesNo) = vbYes Then
Else
Application.Undo
End If
End If
End If
Static EnCours As Boolean 'Permet de trier le Tableau1 par les colonnes D, A et B si A/B/D/E/F remplies - déprotection de la feuille
If EnCours Then Exit Sub
On Error Resume Next
If WorksheetFunction.CountA(Union(Range("A" & Target.Row), Range("B" & Target.Row), Range("D" & Target.Row), Range("E" & Target.Row), Range("F" & Target.Row))) = 5 Then
ActiveSheet.Unprotect Password:="XXXXX"
ActiveSheet.Unprotect , DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True, AllowDeletingRows:=True, AllowInsertingRows:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True
Application.ScreenUpdating = False
EnCours = True
Range("Tableau1").Sort Key1:=Range("D3"), Order1:=xlAscending, Key2:=Range("A3"), Order2:=xlAscending, Key3:=Range("B3"), Order3:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
EnCours = False
'Permet de trier le tableau de charge par la couleur = tableau reste toujours en bas
ActiveSheet.ListObjects("Tableau1").Sort.SortFields. _
Add(Range("Tableau1[NOM COLONNE]"), xlSortOnCellColor, xlDescending, , _
xlSortNormal).SortOnValue.Color = RGB(146, 205, 220)
With ActiveSheet.ListObjects("Tableau1").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWorkbook.Worksheets("NOM FEUILLE").ListObjects("Tableau1").Sort.SortFields. _
Clear
With ActiveWorkbook.Worksheets("NOM FEUILLE").ListObjects("Tableau1").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A3:BZ500").EntireRow.AutoFit 'Permet de réaliser un autofit sur toutes les lignes + reprotection de la feuille
ActiveSheet.Protect Password:="XXXXX", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True, AllowDeletingRows:=True, AllowInsertingRows:=True, AllowFormattingColumns:=False, AllowFormattingRows:=False
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
nombredelignes = ActiveSheet.ListObjects("Tableau1").ListRows.Count
'Permet d'interdire le copier/coller dans les colonnes A:F
If Not Intersect(Target, Range("A:F")) _
Is Nothing Then
Application.CutCopyMode = False
NoCopCol = True
Else
If NoCopCol Then Application.CutCopyMode = False
NoCopCol = False
End If
End SubLe code fonctionne, du moins toutes les fonctionnalités attendues (j'ai découpé les différentes parties au grès de posts sur le forum). Je pense que je tiens le bon bout ! Alors il y a sûrement des choses à simplifier et je suis preneur si jamais.
Le dernier problème que j'ai est la fonction filtre du tableau, pour je ne sais quelle raison, dès fois (pas systématique donc), quand je filtre sur la colonne D, j'ai bien mon filtre qui fonctionne mais quand je rajoute une ligne + je remplis les cellules permettant le tri (condition: A/B/D/E/F remplies), le filtre se reset au lieu de rester sur la valeur sélectionnée de la colonne D. Et d'autres fois je fais exactement la même manip, mais c'est en remplissant une cellule dans la table de charge (de la colonne G à AX), que le filtre reset.
Vous avez des coms dans le code pour comprendre chaque action.
Si vous avez une solution je suis preneur :D !
Merci beaucoup !
Cordialement !
Ok j'ai compris l'enchaînement d'évènement qui provoque le reset du filtre (j'essaye d'être le plus clair possible :) ).
Je sélectionne une variable à filtrer dans la colonne D et j'active le code macro
Si je décide de changer de variable D, le filtre reset toujours (et j'ai au visuel la flèche de filtre active, alors que toutes mes variables sont visibles car filtre rest).
Pour revenir à la normale, je dois resélectionner toutes les variables dans le filtre (= choix sélectionner tous), sortir du filtre = reset de la flèche de filtre et resélectionner la variable que je veux filtrer = flèche de filtre revenue.