XL 2016 excel

[A2M]

Bonjour

J'utilise depuis 2 ans un fichier excel pour faire des reportings. J'insère les données du mois M-1, puis via des macros et des TCD, je sors mes reportings
Le fichier est aujourd'hui volumineux (80 Méga)
Depuis quelques semaine, je n'arrive plus à l'enregistrer. Lorsque je clique sur la disquette, j'ai le message de l'inspecteur de document, je clique sur Ok, puis excel se ferme sans avoir sauvegardé le fichier
J'ai essayé de déplacer le fichier vers un autre dossier, j'ai décoché la case "supprimer les informations personnelles..." dans le centre de gestion de la confidentialité, rien n'y fait.
quelqu'un aurait il une solution svp?
Merci

 

[Phil69970]

Bonjour @A2M

Perso j'utilise ce module (que j'avais récupéré sur le net revu un peu à ma sauce) pour faire faire une cure d'amaigrissement à mes fichiers excel

A mettre impérativement dans un module ET faire une copie AVANT du fichier excel

A chaque étape il y a des messages ou tu peux voir l'avancement de chaque feuille
==> *Si tu as 50 onglets tu vas valider 50 messages 😄 😄

*Perso je l'associe à un contrôle de date et quand la date du jour dépasse de 120 jours la date enregistrée dans une cellule spécifique le nettoyage se lance (je l'ai désactivée dans le code ci dessous)

Sub Nettoie()

Application.EnableEvents = False ' => Desactive les événements

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

Dim Reponse As Byte
'Reponse = MsgBox("L'optimisation du fichier XXX date de plus de 120 jours, une optimisation pourrait être utile ...", 305, "Optimisation requise")
'If Reponse = 2 Then Exit Sub

Reponse = MsgBox("Pour le classeur actif : " & Chr(10) & ActiveWorkbook.FullName & Chr(10) & "dans chaque feuille (onglet)" _
& Chr(10) & "recherche de 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", 305, "Lancement de l'optimisation") 'vbOKCancel) 'vbInformation

If Reponse = 2 Then Exit Sub

MsgBox "Taille initiale de ce classeur en octets" & Chr(10) & FileLen(ActiveWorkbook.FullName), _
vbInformation, ActiveWorkbook.FullName
Dim T1 As Long
T1 = FileLen(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.FullName
Dim T2 As Long
T2 = FileLen(ActiveWorkbook.FullName)
MsgBox "Taille avant optimisation :" & T1 & " octets" & Chr(10) & "Taille apres optimisation :" & T2 & " octets" & Chr(10) _
& Chr(10) & "Gain de " & T1 - T2 & " octets"

Application.StatusBar = False
Application.Calculation = Calc

'Sheets("Nom_RH").Range("j1").Value = Date

Application.EnableEvents = True ' => Active les événements

End Sub

@Phil69970

 

[kiki29]

Salut, à voir également : VBA CODE DECOMPILER AND COMPACTOR