Problème Mise en place Filtre par VBA

gant1801 · 5 Mai 2013

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

gant1801 · 10 Mai 2013

Re : Problème Mise en place Filtre par VBA

Personne n'a une idée pour m'aider?
Merci de votre attention!

Staple1600 · 10 Mai 2013

Re : Problème Mise en place Filtre par VBA

Bonsoir à tous

gant1801
Avec un fichier exemple, tu auras sans doute plus de succès 😉
Car il est difficile de tester du code VBA sans fichier, non ?

gant1801 · 11 Mai 2013

Re : Problème Mise en place Filtre par VBA

Pas de soucis, voici un fichier que j'ai simplifié et la macro en question se trouve dans le module 3.
Merci d'avance pour vos bons conseils!!

gant1801 · 13 Mai 2013

Re : Problème Mise en place Filtre par VBA

Vous n'auriez pas une petite piste?

gant1801 · 15 Mai 2013

Re : Problème Mise en place Filtre par VBA

Vous n'auriez pas une petite piste?

gant1801 · 26 Mai 2013

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

gant1801 · 2 Mars 2014

Re : Problème Mise en place Filtre par VBA

Personne ne peut m'aider?

Staple1600 · 2 Mars 2014

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 😱

gant1801 · 2 Mars 2014

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

Problème Mise en place Filtre par VBA

gant1801

XLDnaute Junior

gant1801

XLDnaute Junior

Staple1600

XLDnaute Barbatruc

gant1801

XLDnaute Junior

Pièces jointes

gant1801

XLDnaute Junior

gant1801

XLDnaute Junior

gant1801

XLDnaute Junior

gant1801

XLDnaute Junior

Staple1600

XLDnaute Barbatruc

gant1801

XLDnaute Junior

Discussions similaires

Problème Mise en place Filtre par VBA

XLDnaute Junior

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Junior

Pièces jointes

XLDnaute Junior

XLDnaute Junior

XLDnaute Junior

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Junior

Discussions similaires

Privacy & Transparency

Privacy & Transparency