L'enregistrement d'un classeur Excel 2007 est anormalement long, le
classeur n'est
pas très gros, 6 feuilles sur environs 50 lignes par feuille un peut de
VBA mais rien d'automatique.
J'ai remarqué que dans le répertoire du classeur pendant
l'enregistrement
il se créer un fichier sans extension et vide "0883D220" qui disparaît
à la fin
de l'enregistrement.
Précision c'est le seul classeur qui se comporte ainsi et qui est long
à l'enregistrement
Un code du "MAITRE" (en l'an 2000 !) et là c'est vraiment la dernière cellule :) Patrick Sub NettoieEtDerniereCellule() ' Laurent Longre 2000 Dim Sht As Worksheet, DCell As Range, Calc As Long, Rien As String On Error Resume Next Calc = Application.Calculation With Application .Calculation = xlCalculationManual .StatusBar = "Nettoyage en cours..." .EnableCancelKey = xlErrorHandler .ScreenUpdating = False End With For Each Sht In Worksheets If Sht.UsedRange.Address <> "$A$1" Or Not IsEmpty(Sht.[A1]) Then Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2) If Not DCell Is Nothing Then Sht.Range(DCell, Sht.Cells([A:A].Count, 1)).EntireRow.Clear Set DCell = Nothing Set DCell = Sht.Cells.Find("*", , , , xlByColumns, xlPrevious)(, 2) If Not DCell Is Nothing Then _ Sht.Range(DCell, Sht.[IV1]).EntireColumn.Clear End If Rien = Sht.UsedRange.Address End If Next Sht Application.StatusBar = False Application.Calculation = Calc End Sub
Un code du "MAITRE" (en l'an 2000 !) et là c'est vraiment la dernière
cellule :)
Patrick
Sub NettoieEtDerniereCellule() ' Laurent Longre 2000
Dim Sht As Worksheet, DCell As Range, Calc As Long, Rien As String
On Error Resume Next
Calc = Application.Calculation
With Application
.Calculation = xlCalculationManual
.StatusBar = "Nettoyage en cours..."
.EnableCancelKey = xlErrorHandler
.ScreenUpdating = False
End With
For Each Sht In Worksheets
If Sht.UsedRange.Address <> "$A$1" Or Not IsEmpty(Sht.[A1]) Then
Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2)
If Not DCell Is Nothing Then
Sht.Range(DCell, Sht.Cells([A:A].Count, 1)).EntireRow.Clear
Set DCell = Nothing
Set DCell = Sht.Cells.Find("*", , , , xlByColumns, xlPrevious)(, 2)
If Not DCell Is Nothing Then _
Sht.Range(DCell, Sht.[IV1]).EntireColumn.Clear
End If
Rien = Sht.UsedRange.Address
End If
Next Sht
Application.StatusBar = False
Application.Calculation = Calc
End Sub
Un code du "MAITRE" (en l'an 2000 !) et là c'est vraiment la dernière cellule :) Patrick Sub NettoieEtDerniereCellule() ' Laurent Longre 2000 Dim Sht As Worksheet, DCell As Range, Calc As Long, Rien As String On Error Resume Next Calc = Application.Calculation With Application .Calculation = xlCalculationManual .StatusBar = "Nettoyage en cours..." .EnableCancelKey = xlErrorHandler .ScreenUpdating = False End With For Each Sht In Worksheets If Sht.UsedRange.Address <> "$A$1" Or Not IsEmpty(Sht.[A1]) Then Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2) If Not DCell Is Nothing Then Sht.Range(DCell, Sht.Cells([A:A].Count, 1)).EntireRow.Clear Set DCell = Nothing Set DCell = Sht.Cells.Find("*", , , , xlByColumns, xlPrevious)(, 2) If Not DCell Is Nothing Then _ Sht.Range(DCell, Sht.[IV1]).EntireColumn.Clear End If Rien = Sht.UsedRange.Address End If Next Sht Application.StatusBar = False Application.Calculation = Calc End Sub
HB
Très beau code, en effet. j'aime le raffinement : - L'état de application.calculation est stocké pour être restauré à la fin même si dans 98,87 % des cas (au moins) c'est en auto. - la barre de statut est utilisée pour indiquer que le boulot est en cours. Toutefois 1) puisque qu'il y a "On Error Resume Next" l'instruction Application.EnableCancelKey = xlErrorHandler équivaut, je pense, à Application.EnableCancelKey =xlDisabled 2) Un petit coup de Application.ScreenUpdating = True serait logique juste avant Application.StatusBar = False ...mais la mise à jour de la barre de statut se fait tout de même quand tout est fini ... mais ... bon ... je pinaille ;o) HB Le 05/11/2016 à 18:13, Patrick a écrit :
Un code du "MAITRE" (en l'an 2000 !) et là c'est vraiment la dernière cellule :) Patrick Sub NettoieEtDerniereCellule() ' Laurent Longre 2000 Dim Sht As Worksheet, DCell As Range, Calc As Long, Rien As String On Error Resume Next Calc = Application.Calculation With Application .Calculation = xlCalculationManual .StatusBar = "Nettoyage en cours..." .EnableCancelKey = xlErrorHandler .ScreenUpdating = False End With For Each Sht In Worksheets If Sht.UsedRange.Address <> "$A$1" Or Not IsEmpty(Sht.[A1]) Then Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2) If Not DCell Is Nothing Then Sht.Range(DCell, Sht.Cells([A:A].Count, 1)).EntireRow.Clear Set DCell = Nothing Set DCell = Sht.Cells.Find("*", , , , xlByColumns, xlPrevious)(, 2) If Not DCell Is Nothing Then _ Sht.Range(DCell, Sht.[IV1]).EntireColumn.Clear End If Rien = Sht.UsedRange.Address End If Next Sht Application.StatusBar = False Application.Calculation = Calc End Sub
--- L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast. https://www.avast.com/antivirus
Très beau code, en effet.
j'aime le raffinement :
- L'état de application.calculation est stocké
pour être restauré à la fin
même si dans 98,87 % des cas (au moins) c'est en auto.
- la barre de statut est utilisée
pour indiquer que le boulot est en cours.
Toutefois
1) puisque qu'il y a
"On Error Resume Next"
l'instruction
Application.EnableCancelKey = xlErrorHandler
équivaut, je pense, à
Application.EnableCancelKey =xlDisabled
2) Un petit coup de
Application.ScreenUpdating = True
serait logique juste avant
Application.StatusBar = False
...mais la mise à jour de la barre de statut
se fait tout de même quand tout est fini ...
mais ... bon ... je pinaille ;o)
HB
Le 05/11/2016 à 18:13, Patrick a écrit :
Un code du "MAITRE" (en l'an 2000 !) et là c'est vraiment la dernière
cellule :)
Patrick
Sub NettoieEtDerniereCellule() ' Laurent Longre 2000
Dim Sht As Worksheet, DCell As Range, Calc As Long, Rien As String
On Error Resume Next
Calc = Application.Calculation
With Application
.Calculation = xlCalculationManual
.StatusBar = "Nettoyage en cours..."
.EnableCancelKey = xlErrorHandler
.ScreenUpdating = False
End With
For Each Sht In Worksheets
If Sht.UsedRange.Address <> "$A$1" Or Not IsEmpty(Sht.[A1]) Then
Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2)
If Not DCell Is Nothing Then
Sht.Range(DCell, Sht.Cells([A:A].Count, 1)).EntireRow.Clear
Set DCell = Nothing
Set DCell = Sht.Cells.Find("*", , , , xlByColumns, xlPrevious)(, 2)
If Not DCell Is Nothing Then _
Sht.Range(DCell, Sht.[IV1]).EntireColumn.Clear
End If
Rien = Sht.UsedRange.Address
End If
Next Sht
Application.StatusBar = False
Application.Calculation = Calc
End Sub
---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
https://www.avast.com/antivirus
Très beau code, en effet. j'aime le raffinement : - L'état de application.calculation est stocké pour être restauré à la fin même si dans 98,87 % des cas (au moins) c'est en auto. - la barre de statut est utilisée pour indiquer que le boulot est en cours. Toutefois 1) puisque qu'il y a "On Error Resume Next" l'instruction Application.EnableCancelKey = xlErrorHandler équivaut, je pense, à Application.EnableCancelKey =xlDisabled 2) Un petit coup de Application.ScreenUpdating = True serait logique juste avant Application.StatusBar = False ...mais la mise à jour de la barre de statut se fait tout de même quand tout est fini ... mais ... bon ... je pinaille ;o) HB Le 05/11/2016 à 18:13, Patrick a écrit :
Un code du "MAITRE" (en l'an 2000 !) et là c'est vraiment la dernière cellule :) Patrick Sub NettoieEtDerniereCellule() ' Laurent Longre 2000 Dim Sht As Worksheet, DCell As Range, Calc As Long, Rien As String On Error Resume Next Calc = Application.Calculation With Application .Calculation = xlCalculationManual .StatusBar = "Nettoyage en cours..." .EnableCancelKey = xlErrorHandler .ScreenUpdating = False End With For Each Sht In Worksheets If Sht.UsedRange.Address <> "$A$1" Or Not IsEmpty(Sht.[A1]) Then Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2) If Not DCell Is Nothing Then Sht.Range(DCell, Sht.Cells([A:A].Count, 1)).EntireRow.Clear Set DCell = Nothing Set DCell = Sht.Cells.Find("*", , , , xlByColumns, xlPrevious)(, 2) If Not DCell Is Nothing Then _ Sht.Range(DCell, Sht.[IV1]).EntireColumn.Clear End If Rien = Sht.UsedRange.Address End If Next Sht Application.StatusBar = False Application.Calculation = Calc End Sub
--- L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast. https://www.avast.com/antivirus
