Créer une sauvegarde annuelle

Salut à tous !

Ci-joint , un fichier avec macro qui fonctionne à merveille.

Seulement, j'aimerais lui apporter une petite modification.

Alors voilà : chaque début d'année, à la première ouverture du fichier, je voudrais qu'une sauvegarde appelée "Contrôle gaz_année 2018" soit créée automatiquement et soit stockée dans" C:/Sauvegarde annuelle relevé des gaz"

Merci pour votre aide. Mon fichier est joint.le mot de passe est frittage0.

Jojo

Bonjour

Avec un fichier protégé, on ne peut pas aller bien loin..;

Bye !

Oops!!

Désolé.

Mot de passe : frittage0

Bonjour,

Une piste avec un "Nom" invisible dans le gestionnaire de noms dont le contrôle de l'existence se fait à chaque ouverture. Tant que le nom existe, nous sommes dans l'année en cours (il est composé d'un préfixe "PremOuv_" et de l'année). Sitôt que l'année change (1er janvier) le nom sera caduque car composé avec l'année qui ne correspondra plus, ce qui va générer la sauvegarde. La procédure ci-dessous "PremOuverture()" est à appeler sur l'événement "Workbook_Open()" du classeur :

        .Unprotect "frittage0"
        .Range("B" & ligneDateDujour).Interior.ColorIndex = 6 'il faut enlever le MDP pour cette commande
        .Protect "frittage0"
    End With

    PremOuverture'<--- appel en fin de procédure !

End Sub

A mettre dans le module standard avec celles que je t'ai déjà donné :

Sub PremOuverture()

    Dim Nom As Name
    Dim Chemin As String
    Dim Fichier As String

    On Error Resume Next
    Set Nom = ThisWorkbook.Names("PremOuv_" & Year(Date)) 'affecte le nom à la variable

    'si il n'existe pas, une erreur est générée donc...
    If Err.Number <> 0 Then

        '...supprime l'éventuel ancien nom (année en cours moins 1)
        Set Nom = ThisWorkbook.Names("PremOuv_" & Year(Date) - 1)
        Nom.Delete

        Chemin ="C:\Sauvegarde annuelle relevé des gaz\"
        Fichier = "Contrôle gaz_année " & Year(Date) - 1 & ".xlsm" '<--- sauvegarde avec l'année précédente

        'effectue la sauvegarde
        ThisWorkbook.SaveCopyAs Chemin & Fichier

        'crée le nouveau nom pour l'année en cours
        'tant que l'année ne change pas, le nom existe et donc, pas de sauvegarde annuelle !
        ThisWorkbook.Names.Add "PremOuv_" & Year(Date), Year(Date), False

    End If

End Sub

Bonjour Theze !

Merci beaucoup pour le code et pour les explications.

Je copie tout ça et j'attends le 1er janvier 2019 pour tester !

Bonne soirée et peut-être à bientôt !

Jojo

En plus , j'ai tout compris !

Hello jojo !

Et bien attendons janvier 2019

J'ai copié les lignes de code là où elles devaient aller.

J'ai fait un essai en ayant préalablement changé la date de mon pc au 1/1/18. Rien ne se passe: pas de création de fichier de sauvegarde annuelle dans le dossier de destination.

Je suis perplexe...

Jojo

Re,

J'ai fait un essai en ayant préalablement changé la date de mon pc au 1/1/18. Rien ne se passe: pas de création de fichier de sauvegarde annuelle dans le dossier de destination.

Pour le test, il n'est pas nécessaire de changer la date de ton PC puisque quand tu lances le code pour la première fois dans ton classeur le nom n'existe forcément pas donc, tu entres dans le bloc If ... Then et le fichier de sauvegarde est forcément créé avec l'année 2017 (2018 quand on sera en 2019).

J'ai modifié le code pour qu'il y ai un contrôle en fin de procédure pour indiquer si la sauvegarde a réussie ou pas :

Sub PremOuverture()

    Dim Nom As Name
    Dim Chemin As String
    Dim Fichier As String

    On Error Resume Next
    Set Nom = ThisWorkbook.Names("PremOuv_" & Year(Date)) 'affecte le nom à la variable

    'si il n'existe pas, une erreur est générée donc...
    If Err.Number <> 0 Then

        '...supprime l'éventuel ancien nom (année en cours moins 1)
        Set Nom = ThisWorkbook.Names("PremOuv_" & Year(Date) - 1)
        Nom.Delete

        Chemin = "C:\Sauvegarde annuelle relevé des gaz\"
        Fichier = "Contrôle gaz_année " & Year(Date) - 1 & ".xlsm" '<--- sauvegarde avec l'année précédente

        'effectue la sauvegarde
        ThisWorkbook.SaveCopyAs Chemin & Fichier

        'crée le nouveau nom pour l'année en cours
        'tant que l'année ne change pas, le nom existe et donc, pas de sauvegarde annuelle !
        ThisWorkbook.Names.Add "PremOuv_" & Year(Date), Year(Date), False

        If Dir(Chemin & Fichier) <> "" Then

            MsgBox "La sauvegarde du classeur a réussie !" _
                   & vbCrLf _
                   & vbCrLf _
                   & "Le fichier est dans le dossier '" & Chemin & "' et porte le nom : '" & Fichier & "'"

        Else

            MsgBox "Une erreur est survenue, la sauvegarde n'a pas réussie !"

        End If

    End If

End Sub

Pour tester le code, parcours le en pas à pas (touche F8) pour voir comment il se comporte ! Je n'est pas testé sur "Workbook_Open()" sinon, à tester sur "Workbook_Activate()"

J'ai aussi mis un fichier excel nommé "PremOuv_2017" dans le dossier "Sauvegardes annuelles", il ne se fait pas supprimer.

Comme la sauvegarde n'est faite qu'une fois par an, il ne doit normalement pas exister de classeur de sauvegarde de l'année qui vient de passer, non ? Sinon, tu peux utiliser Kill pour le supprimer avant en faisant un test avec Dir() :

If Dir(Chemin & Fichier) <> "" Then Kill Chemin & Fichier

Pour savoir si le nom existe dans le classeur, tu peux exécuter cette proc :

Sub Test()

    Dim Nom As Name

    On Error Resume Next
    Set Nom = ThisWorkbook.Names("PremOuv_" & Year(Date))

    If Err.Number = 0 Then
        MsgBox "Le nom existe !"
    Else
        MsgBox "Le nom n'existe pas !"
    End If

    'Nom.Delete 'permet de supprimer le nom du classeur

End Sub

Bon, je te laisse faire quelques tests !

Merci Theze

Je copie, je teste et j'aissaie de comprendre.

Bonne soirée !

Jojo

nickel Chrome !!!

Ça marche super bien!

Je suis super content.

Encore merci !

Jojo

Bonjour,

Donc pas la peine d'attendre l'année prochaine

Content de t'avoir aidé