Bonjour à tous...
J'ai une petite question pour vous.
J'ai un projet dont je me sert comme outils de gestion...
Il s'agit d'un fichier qui à tout prês de 8mo.... de formules et de
programmation...
Est-ce que quelqu'un à un conseil pour moi ou un ménage à me proposer pour
alléger mon projet?
J'ai appris VBA sur le tas et beaucoup avec votre aide et je vous en
remercie beaucoup
Merci beaucoup encore à tous.
Jo-J
Bonjour à tous...
J'ai une petite question pour vous.
J'ai un projet dont je me sert comme outils de gestion...
Il s'agit d'un fichier qui à tout prês de 8mo.... de formules et de
programmation...
Est-ce que quelqu'un à un conseil pour moi ou un ménage à me proposer pour
alléger mon projet?
J'ai appris VBA sur le tas et beaucoup avec votre aide et je vous en
remercie beaucoup
Merci beaucoup encore à tous.
Jo-J
Bonjour à tous...
J'ai une petite question pour vous.
J'ai un projet dont je me sert comme outils de gestion...
Il s'agit d'un fichier qui à tout prês de 8mo.... de formules et de
programmation...
Est-ce que quelqu'un à un conseil pour moi ou un ménage à me proposer pour
alléger mon projet?
J'ai appris VBA sur le tas et beaucoup avec votre aide et je vous en
remercie beaucoup
Merci beaucoup encore à tous.
Jo-J
Bonjour Jo,
Tu peux insérer ce code dans ton classeur et l'exécuter.
Ça pourrait le faire maigrir !
'-------------------------------------
Sub Nettoie()
Dim Sht As Worksheet, DCell As Range, Calc As Long
Dim 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 :" & vbCrLf & _
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
'-------------------------------------
Salutations!
"Jo-Julie" a écrit dans le message de
news:
Bonjour à tous...
J'ai une petite question pour vous.
J'ai un projet dont je me sert comme outils de gestion...
Il s'agit d'un fichier qui à tout prês de 8mo.... de formules et de
programmation...
Est-ce que quelqu'un à un conseil pour moi ou un ménage à me proposer pour
alléger mon projet?
J'ai appris VBA sur le tas et beaucoup avec votre aide et je vous en
remercie beaucoup
Merci beaucoup encore à tous.
Jo-J
Bonjour Jo,
Tu peux insérer ce code dans ton classeur et l'exécuter.
Ça pourrait le faire maigrir !
'-------------------------------------
Sub Nettoie()
Dim Sht As Worksheet, DCell As Range, Calc As Long
Dim 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 :" & vbCrLf & _
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
'-------------------------------------
Salutations!
"Jo-Julie" <JoJulie@discussions.microsoft.com> a écrit dans le message de
news: 3538CA8B-3B04-40A0-893D-B36C8A142F74@microsoft.com...
Bonjour à tous...
J'ai une petite question pour vous.
J'ai un projet dont je me sert comme outils de gestion...
Il s'agit d'un fichier qui à tout prês de 8mo.... de formules et de
programmation...
Est-ce que quelqu'un à un conseil pour moi ou un ménage à me proposer pour
alléger mon projet?
J'ai appris VBA sur le tas et beaucoup avec votre aide et je vous en
remercie beaucoup
Merci beaucoup encore à tous.
Jo-J
Bonjour Jo,
Tu peux insérer ce code dans ton classeur et l'exécuter.
Ça pourrait le faire maigrir !
'-------------------------------------
Sub Nettoie()
Dim Sht As Worksheet, DCell As Range, Calc As Long
Dim 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 :" & vbCrLf & _
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
'-------------------------------------
Salutations!
"Jo-Julie" a écrit dans le message de
news:
Bonjour à tous...
J'ai une petite question pour vous.
J'ai un projet dont je me sert comme outils de gestion...
Il s'agit d'un fichier qui à tout prês de 8mo.... de formules et de
programmation...
Est-ce que quelqu'un à un conseil pour moi ou un ménage à me proposer pour
alléger mon projet?
J'ai appris VBA sur le tas et beaucoup avec votre aide et je vous en
remercie beaucoup
Merci beaucoup encore à tous.
Jo-J
Bonjour Jo,
Tu peux insérer ce code dans ton classeur et l'exécuter.
Ça pourrait le faire maigrir !
'-------------------------------------
Sub Nettoie()
Dim Sht As Worksheet, DCell As Range, Calc As Long
Dim 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 :" & vbCrLf & _
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
'-------------------------------------
Salutations!
"Jo-Julie" a écrit dans le message de
news:
Bonjour à tous...
J'ai une petite question pour vous.
J'ai un projet dont je me sert comme outils de gestion...
Il s'agit d'un fichier qui à tout prês de 8mo.... de formules et de
programmation...
Est-ce que quelqu'un à un conseil pour moi ou un ménage à me proposer pour
alléger mon projet?
J'ai appris VBA sur le tas et beaucoup avec votre aide et je vous en
remercie beaucoup
Merci beaucoup encore à tous.
Jo-J
Bonjour Jo,
Tu peux insérer ce code dans ton classeur et l'exécuter.
Ça pourrait le faire maigrir !
'-------------------------------------
Sub Nettoie()
Dim Sht As Worksheet, DCell As Range, Calc As Long
Dim 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 :" & vbCrLf & _
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
'-------------------------------------
Salutations!
"Jo-Julie" <JoJulie@discussions.microsoft.com> a écrit dans le message de
news: 3538CA8B-3B04-40A0-893D-B36C8A142F74@microsoft.com...
Bonjour à tous...
J'ai une petite question pour vous.
J'ai un projet dont je me sert comme outils de gestion...
Il s'agit d'un fichier qui à tout prês de 8mo.... de formules et de
programmation...
Est-ce que quelqu'un à un conseil pour moi ou un ménage à me proposer pour
alléger mon projet?
J'ai appris VBA sur le tas et beaucoup avec votre aide et je vous en
remercie beaucoup
Merci beaucoup encore à tous.
Jo-J
Bonjour Jo,
Tu peux insérer ce code dans ton classeur et l'exécuter.
Ça pourrait le faire maigrir !
'-------------------------------------
Sub Nettoie()
Dim Sht As Worksheet, DCell As Range, Calc As Long
Dim 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 :" & vbCrLf & _
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
'-------------------------------------
Salutations!
"Jo-Julie" a écrit dans le message de
news:
Bonjour à tous...
J'ai une petite question pour vous.
J'ai un projet dont je me sert comme outils de gestion...
Il s'agit d'un fichier qui à tout prês de 8mo.... de formules et de
programmation...
Est-ce que quelqu'un à un conseil pour moi ou un ménage à me proposer pour
alléger mon projet?
J'ai appris VBA sur le tas et beaucoup avec votre aide et je vous en
remercie beaucoup
Merci beaucoup encore à tous.
Jo-J
Bonjour JLuc,Il est bizarre ton code
Cette procédure est signée : d'après LL par
Tu as essayé sur un classeur un peu volumineux ?
Il y a même une adresse où tu peux adresser tes doléances
Salutations!
"JLuc" a écrit dans le message de news:
*Bonjour michdenis*,
Il est bizarre ton code, au debut j'avais 839xx octets et maintenant
j'ai 114xxx octets :-?Bonjour Jo,
Tu peux insérer ce code dans ton classeur et l'exécuter.
Ça pourrait le faire maigrir !
'-------------------------------------
Sub Nettoie()
Dim Sht As Worksheet, DCell As Range, Calc As Long
Dim 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 :" & vbCrLf & _
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
'-------------------------------------
Salutations!
"Jo-Julie" a écrit dans le message de
news:
Bonjour à tous...
J'ai une petite question pour vous.
J'ai un projet dont je me sert comme outils de gestion...
Il s'agit d'un fichier qui à tout prês de 8mo.... de formules et de
programmation...
Est-ce que quelqu'un à un conseil pour moi ou un ménage à me proposer pour
alléger mon projet?
J'ai appris VBA sur le tas et beaucoup avec votre aide et je vous en
remercie beaucoup
Merci beaucoup encore à tous.
Jo-J
Bonjour JLuc,
Il est bizarre ton code
Cette procédure est signée : d'après LL par GeeDee@enlevez-moi-m6net.fr
Tu as essayé sur un classeur un peu volumineux ?
Il y a même une adresse où tu peux adresser tes doléances
Salutations!
"JLuc" <ns.jeanluc.laurent@free.fr.ns> a écrit dans le message de news:
mn.cd327d5b2ea897cb.40692@free.fr.ns... *Bonjour michdenis*,
Il est bizarre ton code, au debut j'avais 839xx octets et maintenant
j'ai 114xxx octets :-?
Bonjour Jo,
Tu peux insérer ce code dans ton classeur et l'exécuter.
Ça pourrait le faire maigrir !
'-------------------------------------
Sub Nettoie()
Dim Sht As Worksheet, DCell As Range, Calc As Long
Dim 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 :" & vbCrLf & _
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
'-------------------------------------
Salutations!
"Jo-Julie" <JoJulie@discussions.microsoft.com> a écrit dans le message de
news: 3538CA8B-3B04-40A0-893D-B36C8A142F74@microsoft.com...
Bonjour à tous...
J'ai une petite question pour vous.
J'ai un projet dont je me sert comme outils de gestion...
Il s'agit d'un fichier qui à tout prês de 8mo.... de formules et de
programmation...
Est-ce que quelqu'un à un conseil pour moi ou un ménage à me proposer pour
alléger mon projet?
J'ai appris VBA sur le tas et beaucoup avec votre aide et je vous en
remercie beaucoup
Merci beaucoup encore à tous.
Jo-J
Bonjour JLuc,Il est bizarre ton code
Cette procédure est signée : d'après LL par
Tu as essayé sur un classeur un peu volumineux ?
Il y a même une adresse où tu peux adresser tes doléances
Salutations!
"JLuc" a écrit dans le message de news:
*Bonjour michdenis*,
Il est bizarre ton code, au debut j'avais 839xx octets et maintenant
j'ai 114xxx octets :-?Bonjour Jo,
Tu peux insérer ce code dans ton classeur et l'exécuter.
Ça pourrait le faire maigrir !
'-------------------------------------
Sub Nettoie()
Dim Sht As Worksheet, DCell As Range, Calc As Long
Dim 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 :" & vbCrLf & _
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
'-------------------------------------
Salutations!
"Jo-Julie" a écrit dans le message de
news:
Bonjour à tous...
J'ai une petite question pour vous.
J'ai un projet dont je me sert comme outils de gestion...
Il s'agit d'un fichier qui à tout prês de 8mo.... de formules et de
programmation...
Est-ce que quelqu'un à un conseil pour moi ou un ménage à me proposer pour
alléger mon projet?
J'ai appris VBA sur le tas et beaucoup avec votre aide et je vous en
remercie beaucoup
Merci beaucoup encore à tous.
Jo-J
Bonjour JLuc,Il est bizarre ton code
Cette procédure est signée : d'après LL par
Tu as essayé sur un classeur un peu volumineux ?
Il y a même une adresse où tu peux adresser tes doléances
Salutations!
"JLuc" a écrit dans le message de news:
*Bonjour michdenis*,
Il est bizarre ton code, au debut j'avais 839xx octets et maintenant
j'ai 114xxx octets :-?Bonjour Jo,
Tu peux insérer ce code dans ton classeur et l'exécuter.
Ça pourrait le faire maigrir !
'-------------------------------------
Sub Nettoie()
Dim Sht As Worksheet, DCell As Range, Calc As Long
Dim 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 :" & vbCrLf & _
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
'-------------------------------------
Salutations!
"Jo-Julie" a écrit dans le message de
news:
Bonjour à tous...
J'ai une petite question pour vous.
J'ai un projet dont je me sert comme outils de gestion...
Il s'agit d'un fichier qui à tout prês de 8mo.... de formules et de
programmation...
Est-ce que quelqu'un à un conseil pour moi ou un ménage à me proposer pour
alléger mon projet?
J'ai appris VBA sur le tas et beaucoup avec votre aide et je vous en
remercie beaucoup
Merci beaucoup encore à tous.
Jo-J
Bonjour JLuc,
Il est bizarre ton code
Cette procédure est signée : d'après LL par GeeDee@enlevez-moi-m6net.fr
Tu as essayé sur un classeur un peu volumineux ?
Il y a même une adresse où tu peux adresser tes doléances
Salutations!
"JLuc" <ns.jeanluc.laurent@free.fr.ns> a écrit dans le message de news:
mn.cd327d5b2ea897cb.40692@free.fr.ns... *Bonjour michdenis*,
Il est bizarre ton code, au debut j'avais 839xx octets et maintenant
j'ai 114xxx octets :-?
Bonjour Jo,
Tu peux insérer ce code dans ton classeur et l'exécuter.
Ça pourrait le faire maigrir !
'-------------------------------------
Sub Nettoie()
Dim Sht As Worksheet, DCell As Range, Calc As Long
Dim 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 :" & vbCrLf & _
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
'-------------------------------------
Salutations!
"Jo-Julie" <JoJulie@discussions.microsoft.com> a écrit dans le message de
news: 3538CA8B-3B04-40A0-893D-B36C8A142F74@microsoft.com...
Bonjour à tous...
J'ai une petite question pour vous.
J'ai un projet dont je me sert comme outils de gestion...
Il s'agit d'un fichier qui à tout prês de 8mo.... de formules et de
programmation...
Est-ce que quelqu'un à un conseil pour moi ou un ménage à me proposer pour
alléger mon projet?
J'ai appris VBA sur le tas et beaucoup avec votre aide et je vous en
remercie beaucoup
Merci beaucoup encore à tous.
Jo-J
Bonjour JLuc,Il est bizarre ton code
Cette procédure est signée : d'après LL par
Tu as essayé sur un classeur un peu volumineux ?
Il y a même une adresse où tu peux adresser tes doléances
Salutations!
"JLuc" a écrit dans le message de news:
*Bonjour michdenis*,
Il est bizarre ton code, au debut j'avais 839xx octets et maintenant
j'ai 114xxx octets :-?Bonjour Jo,
Tu peux insérer ce code dans ton classeur et l'exécuter.
Ça pourrait le faire maigrir !
'-------------------------------------
Sub Nettoie()
Dim Sht As Worksheet, DCell As Range, Calc As Long
Dim 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 :" & vbCrLf & _
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
'-------------------------------------
Salutations!
"Jo-Julie" a écrit dans le message de
news:
Bonjour à tous...
J'ai une petite question pour vous.
J'ai un projet dont je me sert comme outils de gestion...
Il s'agit d'un fichier qui à tout prês de 8mo.... de formules et de
programmation...
Est-ce que quelqu'un à un conseil pour moi ou un ménage à me proposer pour
alléger mon projet?
J'ai appris VBA sur le tas et beaucoup avec votre aide et je vous en
remercie beaucoup
Merci beaucoup encore à tous.
Jo-J
