Limiter le nbre de sauvegrdes

Bonjour à tous,

Je cherche à sauvegarder un fichier avec heure, j'ai la solution qui fonctionne très bien.

Mais j'aimerais bien limiter ces sauvegardes à 2 voire 3 en effaçant bien-sûr à chaque fois la plus ancienne.

Je sais que ce sujet à été traité dans le forum, mais rien qui puisse me convenir.

Je cherche quelque chose de simple en complétant cette macro.

Merci de votre aide.

Daryl.B

Bonjour,

Je te propose ce code qui utilise un nom (invisible dans la boîte des noms) afin d'y stocker l'heure d'enregistrement et de comparer au délai voulu entre chaque sauvegarde :

Sub Sauvegarde(NBHeure As Integer, Retour As Boolean)

    Dim Heure As Single
    Dim Delai As Single
    Dim Nom As Name
    Dim Sep As String

    Sep = Format(0, ".") 'séparateur décimal

    'vérifie si le nom existe ("Enregistrement"), si il n'existe pas, le crée avec comme valeur l'heure du moment
    'le noml n'estg pas visible dans la boite des noms et autorise l'enregistrement en mettant l'argument "Retour" à vrai

    On Error Resume Next
    Set Nom = ThisWorkbook.Names("Enregistrement")

    If Err.Number <> 0 Then

        On Error GoTo 0 'supprime le gestionnaire

        ThisWorkbook.Names.Add "Enregistrement", Time, False
        Retour = True
        Exit Sub

    End If

    On Error GoTo 0 'supprime le gestionnaire

    'récupère l'heure stocké dans le nom en type Single
    Heure = CSng(Replace(Right(Nom, Len(Nom) - 1), ".", Sep))

    'défini le délai
    Delai = 1 / 24 * NBHeure

    'si l'heure du moment moins l'heure stockée dans le nom est inférieur au délai, informe
    'et n 'autorise pas l'enregistrement en mettant l'argument "Retour" à faux
    'sinon, redéfini la valeur dans le nom à l'heure du moment et autorise l'enregistrement en mettant l'argument "Retour" à vrai
    If CSng(Time) - Heure < Delai Then

        MsgBox "Le classeur à été sauvegardé il y a moins de " & NBHeure & " heures !" & _
               vbCrLf & _
               "Il sera possible de le sauvegarder à nouveau dans " & Format(Delai - (CSng(Time) - Heure), "hh:mm:ss")

        Retour = False

    Else

        ThisWorkbook.Names.Add "Enregistrement", Time, False
        Retour = True

    End If

End Sub

Pour appeler ce code de contrôle, il suffit de mettre l'appel dans le code que tu as fais (voir entre les dollars) :

Sub EnregDateHeure()

'boite de dialogue
Dim Left1 As Variant
Dim Top1 As Variant
Dim HelpFile1 As Variant
Dim HelpContextId1 As Variant '*****************
Dim Prompt1   As String
Dim Title1 As Variant
Dim Default1 As Variant
Dim Type1 As Variant
'response est fonction du type1
Dim reponse1 As String
Dim chemin As String
Dim date1 As String

' si annuler sortie
Left1 = ""
Top1 = ""
HelpFile1 = ""
HelpContextId1 = ""

'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
Dim Retour As Boolean

Sauvegarde 2, Retour
If Retour = False Then Exit Sub
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$

Prompt1 = "Nom du fichier" 'Message à afficher dans la boîte de dialogue
Title1 = "Enregistrer un fichier" 'Titre de la zone de saisie
Default1 = "Exemple du  "

Type1 = 2 ' 0 Une formule. 1 Un nombre. 2 Texte (une chaîne). 4 Une valeur logique (True ou False).
'8 Une référence de cellule, sous la forme d'un objet Range. 16 Une valeur d'erreur, telle que #N/A. 64 Un tableau de valeurs.

reponse1 = Application.InputBox(Prompt:=Prompt1, Title:=Title1, Default:=Default1, Type:=Type1)
If reponse1 = "" Then Exit Sub
'If reponse1 = False Then Exit Sub

chemin = ThisWorkbook.Path & Application.PathSeparator
date1 = Format(Date, " dd-mm-yy ") & " à " & Format(Time, "hh-mm")
 ActiveWorkbook.SaveAs _
            Filename:=chemin & reponse1 & date1 & ".xlsm", _
            FileFormat:=52

 MsgBox ("Simple Sauvegarde Réussie.")
End Sub

A toi de voir comment gérer l'enregistrement à la fermeture du classeur !

Bonjour Theze ,

Je regarde et je reviens un peu plus tard pour en parler.

A première vue, c'est plutôt habile.

Merci.

Daryl.B.

Re-bonjour, Theze ,

J'ai regardé, hum ! un peu compliqué pour moi à l'heure actuelle de mes connaissances.

Merci encore.

C'est très simple, tu colles les deux codes que j'ai posté dans ton module standard puis tu exécutes ta Sub "EnregDateHeure()" à ce moment là, le compilateur va arriver à la ligne :

Sauvegarde 2, Retour

donc, il va sauter dans la Sub "Sauvegarde()" qui elle, demande deux arguments, le premier est le nombre d'heures entre deux autorisations de sauvegarde (ici, 2 heures) et le second, est une variable Booléenne passée en référence (donc, la valeur peut être modifiée dans la Sub appelée) qui va permettre de mettre fin à la Sub "EnregDateHeure()" si le délai est inférieur au nombre d'heures passé en argument (2 heures) avec cette ligne :

If Retour = False Then Exit Sub

Pour la première exécution du code, le nom n'existe pas donc, il va être créé dans ce bloc d'instructions :

If Err.Number <> 0 Then

    On Error GoTo 0 'supprime le gestionnaire

    ThisWorkbook.Names.Add "Enregistrement", Time, False
    Retour = True
    Exit Sub

End If

et comme "Retour" est mis à True, l'enregistrement va être autorisé.

Une fois que tu as fais ça, tu relances à nouveau ta Sub "EnregDateHeure()" et là, tu va avoir un message te disant que la sauvegarde a été réalisée il y a moins de 2 heures et que la prochaine sauvegarde pourra avoir lien dans x heures, minutes et secondes

Donc, rien de difficile.

Si tu veux voir le nom apparaître dans la boite des noms, il te suffit à ces deux lignes :

ThisWorkbook.Names.Add "Enregistrement", Time, False

de changer False en True

Bonsoir Theze,

Effectivement c'est très simple et ludique. J'aime bien.

Je prends.

Merci pour la solution mais aussi pour le petit cours.

Bonne soirée.

Daryl.B

Content de t'avoir aidé