rechercher dans quelles feuilles il y a des filtres, les enlever, puis les remettre
1 réponse
Help Me
Bonjour à tous
Tout d'abord je tenais à tous vous remercier pour les aides diverses et
variées, et surtout salvatrices de neophites comme moi.
Je vous contacte aujourd'hui car je suis confronté à un problème récurent.
En effet, grace à une macro de excellabo (merci aux auteurs), je nettoie les
scripts de tous les caracteres cachés présents et alourdissants...
.. MAIS...s'il y a un filtre en cours dans un onglet d'un classeur, cela
nettoie tout y compris ce qui est masqué par un filtre que je souhaite
garder...donc ma question...
Quelqu'un saurait soit modifier cette macro pour que ce qui est masqué par
un filtre ne saute pas, ou alors, saurait la compléter en detectant s'il y a
un filtre avant de nettoyer, puis de le remettre apres ????
MERCIIIIII a vous tous
Michel
Sub Nettoie() 'Laurent Longre mpfe, mise en forme GeeDee
Dim Sht As Worksheet, DCell As Range, Calc As Long, Rien As String,
Avant As Double, plage As Range
On Error Resume Next
Calc = Application.Calculation ' ---- mémorisation de l'état de
recalcul
'------------------------------------------------------------
MsgBox "Pour le classeur actif : " _
& Chr(10) & ActiveWorkbook.FullName _
& Chr(10) & "dans chaque feuille de calcul" _
& Chr(10) & "recherche la zone contenant des données," _
& Chr(10) & "réinitialise la dernière cellule utilisée" _
& Chr(10) & "et optimise la taille du fichier Excel", _
vbInformation, _
"d'après LL par GeeDee@m6net.fr"
'-------------------------------------------------------------
MsgBox "Taille initiale de ce classeur en octets" _
& Chr(10) & FileLen(ActiveWorkbook.FullName), _
vbInformation, ActiveWorkbook.FullName
'------------------------------------------------------------
With Application
.Calculation = xlCalculationManual
.StatusBar = "Nettoyage en cours..."
.EnableCancelKey = xlErrorHandler
.ScreenUpdating = True
End With
'-------------------- le traitement
For Each Sht In Worksheets
Avant = Sht.UsedRange.Cells.Count
Application.StatusBar = Sht.Name & "-" & Sht.UsedRange.Address
'-------------------Traitement de la zone trouvée
If Sht.UsedRange.Address <> "$A$1" Or Not IsEmpty(Sht.[A1]) Then
Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2)
'----------------Suppression des lignes inutilisées
If Not DCell Is Nothing Then
Sht.Range(DCell, Sht.Cells([A:A].Count, 1)).EntireRow.Delete
Set DCell = Nothing
Set DCell = Sht.Cells.Find("*", , , , xlByColumns, xlPrevious)(,2)
'----------------Suppression des colonnes inutilisées
If Not DCell Is Nothing Then Sht.Range(DCell,
Sht.[IV1]).EntireColumn.Delete
End If
Rien = Sht.UsedRange.Address
End If
ActiveWorkbook.Save
'---------------------Message pour la feuille traitée
MsgBox "Nom de la feuille de calcul :" _
& Chr(10) & Sht.Name _
& Chr(10) & Format(Sht.UsedRange.Cells.Count / Avant, "0.00%") &
_
" de la taille initiale", vbInformation, ActiveWorkbook.FullName
Next Sht
'--------------------Message fin de traitement
MsgBox "Taille optimisée de ce classeur en octets " & Chr(10) & _
FileLen(ActiveWorkbook.FullName), _
vbInformation, _
ActiveWorkbook.FullNameActive
'--------------------
Application.StatusBar = False
Application.Calculation = Calc
End Sub
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
isabelle
bonjour Michel,
met cette commande If Sht.AutoFilterMode Then MsgBox "il y a un filtre" juste après la ligne : For Each Sht In Worksheets
isabelle
Bonjour à tous
Tout d'abord je tenais à tous vous remercier pour les aides diverses et variées, et surtout salvatrices de neophites comme moi.
Je vous contacte aujourd'hui car je suis confronté à un problème récurent.
En effet, grace à une macro de excellabo (merci aux auteurs), je nettoie les scripts de tous les caracteres cachés présents et alourdissants... .. MAIS...s'il y a un filtre en cours dans un onglet d'un classeur, cela nettoie tout y compris ce qui est masqué par un filtre que je souhaite garder...donc ma question...
Quelqu'un saurait soit modifier cette macro pour que ce qui est masqué par un filtre ne saute pas, ou alors, saurait la compléter en detectant s'il y a un filtre avant de nettoyer, puis de le remettre apres ????
MERCIIIIII a vous tous
Michel
Sub Nettoie() 'Laurent Longre mpfe, mise en forme GeeDee Dim Sht As Worksheet, DCell As Range, Calc As Long, Rien As String, Avant As Double, plage As Range On Error Resume Next Calc = Application.Calculation ' ---- mémorisation de l'état de recalcul '------------------------------------------------------------ MsgBox "Pour le classeur actif : " _ & Chr(10) & ActiveWorkbook.FullName _ & Chr(10) & "dans chaque feuille de calcul" _ & Chr(10) & "recherche la zone contenant des données," _ & Chr(10) & "réinitialise la dernière cellule utilisée" _ & Chr(10) & "et optimise la taille du fichier Excel", _ vbInformation, _ "d'après LL par " '------------------------------------------------------------- MsgBox "Taille initiale de ce classeur en octets" _ & Chr(10) & FileLen(ActiveWorkbook.FullName), _ vbInformation, ActiveWorkbook.FullName '------------------------------------------------------------ With Application .Calculation = xlCalculationManual .StatusBar = "Nettoyage en cours..." .EnableCancelKey = xlErrorHandler .ScreenUpdating = True End With '-------------------- le traitement For Each Sht In Worksheets Avant = Sht.UsedRange.Cells.Count Application.StatusBar = Sht.Name & "-" & Sht.UsedRange.Address '-------------------Traitement de la zone trouvée If Sht.UsedRange.Address <> "$A$1" Or Not IsEmpty(Sht.[A1]) Then Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2) '----------------Suppression des lignes inutilisées If Not DCell Is Nothing Then Sht.Range(DCell, Sht.Cells([A:A].Count, 1)).EntireRow.Delete Set DCell = Nothing Set DCell = Sht.Cells.Find("*", , , , xlByColumns, xlPrevious)(,2) '----------------Suppression des colonnes inutilisées If Not DCell Is Nothing Then Sht.Range(DCell, Sht.[IV1]).EntireColumn.Delete End If Rien = Sht.UsedRange.Address End If ActiveWorkbook.Save '---------------------Message pour la feuille traitée MsgBox "Nom de la feuille de calcul :" _ & Chr(10) & Sht.Name _ & Chr(10) & Format(Sht.UsedRange.Cells.Count / Avant, "0.00%") & _ " de la taille initiale", vbInformation, ActiveWorkbook.FullName Next Sht '--------------------Message fin de traitement MsgBox "Taille optimisée de ce classeur en octets " & Chr(10) & _ FileLen(ActiveWorkbook.FullName), _ vbInformation, _ ActiveWorkbook.FullNameActive '-------------------- Application.StatusBar = False Application.Calculation = Calc End Sub
bonjour Michel,
met cette commande
If Sht.AutoFilterMode Then MsgBox "il y a un filtre"
juste après la ligne :
For Each Sht In Worksheets
isabelle
Bonjour à tous
Tout d'abord je tenais à tous vous remercier pour les aides diverses et
variées, et surtout salvatrices de neophites comme moi.
Je vous contacte aujourd'hui car je suis confronté à un problème récurent.
En effet, grace à une macro de excellabo (merci aux auteurs), je nettoie les
scripts de tous les caracteres cachés présents et alourdissants...
.. MAIS...s'il y a un filtre en cours dans un onglet d'un classeur, cela
nettoie tout y compris ce qui est masqué par un filtre que je souhaite
garder...donc ma question...
Quelqu'un saurait soit modifier cette macro pour que ce qui est masqué par
un filtre ne saute pas, ou alors, saurait la compléter en detectant s'il y a
un filtre avant de nettoyer, puis de le remettre apres ????
MERCIIIIII a vous tous
Michel
Sub Nettoie() 'Laurent Longre mpfe, mise en forme GeeDee
Dim Sht As Worksheet, DCell As Range, Calc As Long, Rien As String,
Avant As Double, plage As Range
On Error Resume Next
Calc = Application.Calculation ' ---- mémorisation de l'état de
recalcul
'------------------------------------------------------------
MsgBox "Pour le classeur actif : " _
& Chr(10) & ActiveWorkbook.FullName _
& Chr(10) & "dans chaque feuille de calcul" _
& Chr(10) & "recherche la zone contenant des données," _
& Chr(10) & "réinitialise la dernière cellule utilisée" _
& Chr(10) & "et optimise la taille du fichier Excel", _
vbInformation, _
"d'après LL par GeeDee@m6net.fr"
'-------------------------------------------------------------
MsgBox "Taille initiale de ce classeur en octets" _
& Chr(10) & FileLen(ActiveWorkbook.FullName), _
vbInformation, ActiveWorkbook.FullName
'------------------------------------------------------------
With Application
.Calculation = xlCalculationManual
.StatusBar = "Nettoyage en cours..."
.EnableCancelKey = xlErrorHandler
.ScreenUpdating = True
End With
'-------------------- le traitement
For Each Sht In Worksheets
Avant = Sht.UsedRange.Cells.Count
Application.StatusBar = Sht.Name & "-" & Sht.UsedRange.Address
'-------------------Traitement de la zone trouvée
If Sht.UsedRange.Address <> "$A$1" Or Not IsEmpty(Sht.[A1]) Then
Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2)
'----------------Suppression des lignes inutilisées
If Not DCell Is Nothing Then
Sht.Range(DCell, Sht.Cells([A:A].Count, 1)).EntireRow.Delete
Set DCell = Nothing
Set DCell = Sht.Cells.Find("*", , , , xlByColumns, xlPrevious)(,2)
'----------------Suppression des colonnes inutilisées
If Not DCell Is Nothing Then Sht.Range(DCell,
Sht.[IV1]).EntireColumn.Delete
End If
Rien = Sht.UsedRange.Address
End If
ActiveWorkbook.Save
'---------------------Message pour la feuille traitée
MsgBox "Nom de la feuille de calcul :" _
& Chr(10) & Sht.Name _
& Chr(10) & Format(Sht.UsedRange.Cells.Count / Avant, "0.00%") &
_
" de la taille initiale", vbInformation, ActiveWorkbook.FullName
Next Sht
'--------------------Message fin de traitement
MsgBox "Taille optimisée de ce classeur en octets " & Chr(10) & _
FileLen(ActiveWorkbook.FullName), _
vbInformation, _
ActiveWorkbook.FullNameActive
'--------------------
Application.StatusBar = False
Application.Calculation = Calc
End Sub
met cette commande If Sht.AutoFilterMode Then MsgBox "il y a un filtre" juste après la ligne : For Each Sht In Worksheets
isabelle
Bonjour à tous
Tout d'abord je tenais à tous vous remercier pour les aides diverses et variées, et surtout salvatrices de neophites comme moi.
Je vous contacte aujourd'hui car je suis confronté à un problème récurent.
En effet, grace à une macro de excellabo (merci aux auteurs), je nettoie les scripts de tous les caracteres cachés présents et alourdissants... .. MAIS...s'il y a un filtre en cours dans un onglet d'un classeur, cela nettoie tout y compris ce qui est masqué par un filtre que je souhaite garder...donc ma question...
Quelqu'un saurait soit modifier cette macro pour que ce qui est masqué par un filtre ne saute pas, ou alors, saurait la compléter en detectant s'il y a un filtre avant de nettoyer, puis de le remettre apres ????
MERCIIIIII a vous tous
Michel
Sub Nettoie() 'Laurent Longre mpfe, mise en forme GeeDee Dim Sht As Worksheet, DCell As Range, Calc As Long, Rien As String, Avant As Double, plage As Range On Error Resume Next Calc = Application.Calculation ' ---- mémorisation de l'état de recalcul '------------------------------------------------------------ MsgBox "Pour le classeur actif : " _ & Chr(10) & ActiveWorkbook.FullName _ & Chr(10) & "dans chaque feuille de calcul" _ & Chr(10) & "recherche la zone contenant des données," _ & Chr(10) & "réinitialise la dernière cellule utilisée" _ & Chr(10) & "et optimise la taille du fichier Excel", _ vbInformation, _ "d'après LL par " '------------------------------------------------------------- MsgBox "Taille initiale de ce classeur en octets" _ & Chr(10) & FileLen(ActiveWorkbook.FullName), _ vbInformation, ActiveWorkbook.FullName '------------------------------------------------------------ With Application .Calculation = xlCalculationManual .StatusBar = "Nettoyage en cours..." .EnableCancelKey = xlErrorHandler .ScreenUpdating = True End With '-------------------- le traitement For Each Sht In Worksheets Avant = Sht.UsedRange.Cells.Count Application.StatusBar = Sht.Name & "-" & Sht.UsedRange.Address '-------------------Traitement de la zone trouvée If Sht.UsedRange.Address <> "$A$1" Or Not IsEmpty(Sht.[A1]) Then Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2) '----------------Suppression des lignes inutilisées If Not DCell Is Nothing Then Sht.Range(DCell, Sht.Cells([A:A].Count, 1)).EntireRow.Delete Set DCell = Nothing Set DCell = Sht.Cells.Find("*", , , , xlByColumns, xlPrevious)(,2) '----------------Suppression des colonnes inutilisées If Not DCell Is Nothing Then Sht.Range(DCell, Sht.[IV1]).EntireColumn.Delete End If Rien = Sht.UsedRange.Address End If ActiveWorkbook.Save '---------------------Message pour la feuille traitée MsgBox "Nom de la feuille de calcul :" _ & Chr(10) & Sht.Name _ & Chr(10) & Format(Sht.UsedRange.Cells.Count / Avant, "0.00%") & _ " de la taille initiale", vbInformation, ActiveWorkbook.FullName Next Sht '--------------------Message fin de traitement MsgBox "Taille optimisée de ce classeur en octets " & Chr(10) & _ FileLen(ActiveWorkbook.FullName), _ vbInformation, _ ActiveWorkbook.FullNameActive '-------------------- Application.StatusBar = False Application.Calculation = Calc End Sub