Problème Mise en place Filtre par VBA

  • Initiateur de la discussion Initiateur de la discussion gant1801
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

gant1801

XLDnaute Junior
Bonjour,
J'ai réalisé le code suivant qui me permet de mettre en place un filtre en fonction de plusieurs critères.
Néanmoins j'ai deux problèmes lors de la mise en place du filtre:
- Ce dernier effectue un changement de hauteur de ligne (certaines lignes étant plus hautes que d'autres), et ainsi certaines lignes deviennent très peu hautes alors que d'autres prennent la hauteur de la ligne qui était là avant...
- L'autre soucis étant que, lorsque j'exécute ma macro, celle-ci sélectionne certaines cellules qui normalement font appel à un Msgbox. Le Msgbox apparaît donc comme un pop-up et Application.Displayalerts ne suffit pas pour l'arrêter.

Merci beaucoup de votre aide

Code:
Private Sub Workbook_Open()

Application.DisplayAlerts = False

Sheets("Vins").Select

    ActiveWorkbook.Worksheets("Vins").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Vins").AutoFilter.Sort.SortFields.Add(Range("T6:T38" _
        ), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
        , 255, 255)
    ActiveWorkbook.Worksheets("Vins").AutoFilter.Sort.SortFields.Add(Range("T6:T38" _
        ), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(253 _
        , 82, 87)
    ActiveWorkbook.Worksheets("Vins").AutoFilter.Sort.SortFields.Add(Range("T6:T38" _
        ), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(250 _
        , 164, 71)
    ActiveWorkbook.Worksheets("Vins").AutoFilter.Sort.SortFields.Add(Range("T6:T38" _
        ), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(128 _
        , 255, 129)
    ActiveWorkbook.Worksheets("Vins").AutoFilter.Sort.SortFields.Add(Range("T6:T38" _
        ), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(226 _
        , 255, 139)
    ActiveWorkbook.Worksheets("Vins").AutoFilter.Sort.SortFields.Add(Range("T6:T38" _
        ), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(247 _
        , 255, 178)
    ActiveWorkbook.Worksheets("Vins").AutoFilter.Sort.SortFields.Add(Range("B6:B38" _
        ), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
        , 255, 255)
    ActiveWorkbook.Worksheets("Vins").AutoFilter.Sort.SortFields.Add(Range("B6:B38" _
        ), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(208 _
        , 54, 99)
    ActiveWorkbook.Worksheets("Vins").AutoFilter.Sort.SortFields.Add(Range("B6:B38" _
        ), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
        , 236, 143)
    ActiveWorkbook.Worksheets("Vins").AutoFilter.Sort.SortFields.Add(Range("B6:B38" _
        ), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
        , 199, 206)
    ActiveWorkbook.Worksheets("Vins").AutoFilter.Sort.SortFields.Add(Range("B6:B38" _
        ), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
        , 232, 137)
    ActiveWorkbook.Worksheets("Vins").AutoFilter.Sort.SortFields.Add(Range("B6:B38" _
        ), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
        , 199, 206)

    ActiveWorkbook.Worksheets("Vins").AutoFilter.Sort.SortFields.Add Key:=Range( _
        "J6:J38"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Vins").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
Application.DisplayAlerts = True

Sheets("Présentation").Select
Sheets("Listing appellations").Visible = False
End Sub
 
Re : Problème Mise en place Filtre par VBA

Bonjour,
Après de nombreux essais, j'ai (miraculeusement) trouvé une solution à mon problème et ma macro semblait s'exécuter à merveille... Mais une fois enregistré mon classeur, lors de la réouverture un problème apparait!
"Impossible d'ouvrir le document Excel car une partie de son contenu est illisible. Voulez-vous ouvrir et réparer ce classeur?"
Il semblerait que l'erreur vienne du Sub Péremption_Couleur, mais je n'ai aucune idée de pourquoi.
Si vous avez une quelconque information qui pourrait m'aider je vous en serait très reconnaissant!
Merci à tous

Sub Ligne_en_trop()

Dim I As Integer
I = Range("B65000").End(xlUp).Row + 1
If Cells(I, 2).Borders(xlEdgeBottom).LineStyle <> xlNone Then
If Cells(I, 2).Value = 0 Then
Rows(I).Select
Selection.Delete Shift:=xlUp
End If
End If

End Sub

Sub Revoir_hauteur_ligne()

Dim J As Integer
Dim K As Integer
J = Range("B65000").End(xlUp).Row + 1
For K = 6 To J
Rows(K).EntireRow.AutoFit
Rows(K).RowHeight = WorksheetFunction.Max(28, Rows(K).RowHeight)
Next K

End Sub

Sub Péremption_Couleur()

Dim J As Integer
J = Range("B65000").End(xlUp).Row

ActiveWorkbook.Worksheets("Vins").AutoFilter.Sort.SortFields.Clear

ActiveWorkbook.Worksheets("Vins").AutoFilter.Sort.SortFields.Add(Range(Cells(6, 20), Cells(J, 20) _
), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
, 255, 255)
ActiveWorkbook.Worksheets("Vins").AutoFilter.Sort.SortFields.Add(Range(Cells(6, 20), Cells(J, 20) _
), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(253 _
, 82, 87)
ActiveWorkbook.Worksheets("Vins").AutoFilter.Sort.SortFields.Add(Range(Cells(6, 20), Cells(J, 20) _
), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(250 _
, 164, 71)
ActiveWorkbook.Worksheets("Vins").AutoFilter.Sort.SortFields.Add(Range(Cells(6, 20), Cells(J, 20) _
), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(128 _
, 255, 129)
ActiveWorkbook.Worksheets("Vins").AutoFilter.Sort.SortFields.Add(Range(Cells(6, 20), Cells(J, 20) _
), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(226 _
, 255, 139)
ActiveWorkbook.Worksheets("Vins").AutoFilter.Sort.SortFields.Add(Range(Cells(6, 20), Cells(J, 20) _
), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(247 _
, 255, 178)

ActiveWorkbook.Worksheets("Vins").AutoFilter.Sort.SortFields.Add(Range(Cells(6, 2), Cells(J, 2) _
), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
, 255, 255)
ActiveWorkbook.Worksheets("Vins").AutoFilter.Sort.SortFields.Add(Range(Cells(6, 2), Cells(J, 2) _
), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(208 _
, 54, 99)
ActiveWorkbook.Worksheets("Vins").AutoFilter.Sort.SortFields.Add(Range(Cells(6, 2), Cells(J, 2) _
), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
, 236, 143)
ActiveWorkbook.Worksheets("Vins").AutoFilter.Sort.SortFields.Add(Range(Cells(6, 2), Cells(J, 2) _
), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
, 199, 206)
ActiveWorkbook.Worksheets("Vins").AutoFilter.Sort.SortFields.Add(Range(Cells(6, 2), Cells(J, 2) _
), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
, 232, 137)
ActiveWorkbook.Worksheets("Vins").AutoFilter.Sort.SortFields.Add(Range(Cells(6, 2), Cells(J, 2) _
), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
, 199, 206)

ActiveWorkbook.Worksheets("Vins").AutoFilter.Sort.SortFields.Add Key:=Range( _
Cells(6, 10), Cells(J, 10)), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal

With ActiveWorkbook.Worksheets("Vins").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

End Sub


Sub Tri_Péremption_Couleur()

Ligne_en_trop
Range("B6").Select
Péremption_Couleur
Revoir_hauteur_ligne
Range("B6").Select

End Sub
 
Re : Problème Mise en place Filtre par VBA

Bonjour à tous

gant1801
Pour commencer dimensionnes en Long
Dim I As Long
et
Dim J As Long
Ensuite tu enregistres ton classeur avec quelle extension; *.xlsm ou *.xls ou *.xlsx ?

PS: Désolé que le fait que tu joignes un fichier comme je te l'avais suggéré n'ai pas attiré plus de monde dans ton fil en 2013
😱
 
Dernière édition:
Re : Problème Mise en place Filtre par VBA

Rebonjour,

Merci a toi de répondre, ne t'en fais pas si ce sujet n'inspire guère grand monde…

J'ai trouvé le soucis:
Le bout de code suivant était en double, en fait il y en avait un qui avait un quadrillage en plus dans la MFC, mais qui n'était pas inclus dans ce filtre, ce qui faisait un conflit...
Code:
ActiveWorkbook.Worksheets("Vins").AutoFilter.Sort. SortFields.Add(Range(Cells(6, 2), Cells(J, 2) _
), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
, 199, 206)

Ce problème est donc résolu pour le beug. J'ai par ailleurs changé mes intègre par long, ce qui n'a pas d'incidence pour l'instant vu que mon tableur ne comporte pas trop de lignes mais on ne sait jamais.

Merci a toi

Gant
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
29
Affichages
3 K
Réponses
8
Affichages
1 K
Réponses
0
Affichages
1 K
Réponses
6
Affichages
2 K
Réponses
6
Affichages
2 K
Retour