Réduction taille de fichier
Bonjour à tous,
Je sais que la question est souvent posé mais je n'ai pas réussi à régler mon problème.
Je viens de terminer un ficher excel mais qui pèsent très lourd 26 mo. J'ai essayer de supprimer toutes les cellules vides mais la taille ne change pas.
Y a t'il un moyen pour réduire considérablement la taille du fichier ?
Merci par avance de votre aide
Simon
Salut
Tenté de compresse avec winzip ou xinrar
à plus
tu peux diviser par 3 la taille de ton fichier en faisant un copier/coller de tes feuilles en valeur; mais cela te fera perdre tes formules.
Salut,
Colle ce code dans un module et lance la macro.
Selon l'origine du surpoids de ton fichier ça te fera gagner pas mal.
Il se peux que ça ne change rien si le poids du fichier viens d'images ou d'une très grande quantité de données.
Sub Nettoie()
'nettoie le fichier excel en supprimant les cellules inutilisées
Dim Sht As Worksheet
Dim DCell As Range
Dim Calc As Long
Dim Rien As String
Dim Avant As Double
Dim 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
ActiveWorkbook.Save
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