Sub Sauvegarde() 'Staple sur XLD
'Déclarations
Dim WBk As Workbook
Dim WBk_Copie As Workbook
Dim Nom_Sauvegarde As String
Dim i As Long
'///////////////////////////////////
Set WBk = ThisWorkbook
'création du nom du fichier backup
Nom_Sauvegarde = "Sauvegarde du " & Format(Date, "yyyy-mm-dd") & ".xls"
'fige l'actualistion de l'écran
Application.ScreenUpdating = False
'enregistre ton document initial
WBk.Save
'ajoute un nouveau classeur avec une seule feuille
Workbooks.Add (1)
'nomme cette feuille "temp" pour éviter
' une erreur lors de la recopie
ActiveWorkbook.Sheets(1).Name = "temp"
'recopie des feuilles dans le nouveau classeur
WBk.Sheets.Copy After:=ActiveWorkbook.Sheets(Sheets.Count)
'transforme les formules en valeur
' (équivalent de copier/collage spécial/valeurs
For i = 1 To ActiveWorkbook.Sheets.Count
With ActiveWorkbook.Sheets(i)
'-------------------------------------------
'Ajout JCGL Efface l'image
.DrawingObjects.Delete
'-------------------------------------------
.UsedRange.Cells.Value = .UsedRange.Cells.Value
'-------------------------------------------
'Ajout JCGL Supprime le code VBA dans la Sauvegarde
On Error Resume Next
.VBProject.VBComponents("Module1").CodeModule
Debut = .ProcStartLine("Sauvegarde", 0)
Lignes = .ProcCountLines("Sauvegarde", 0)
.DeleteLines Debut, Lignes
End With
'-------------------------------------------
Next i
'désactive le message d'alerte
Application.DisplayAlerts = False
With ActiveWorkbook
'supprime la feuille temp crée plus haut
.Worksheets("temp").Delete
'enregisre la copie avec le nom défini
.SaveAs (Nom_Sauvegarde)
'ferme le classeur
.Close
End With
'réactivation de l'écran
Application.ScreenUpdating = True
'réactivation du message d'alerte
Application.DisplayAlerts = True
End Sub