compléter macro de sauvegarde de fichier

[david84]

Bonjour le forum et bonne année à tous,
je me sers de la macro suivante pour sauvegarder un document et j'en suis très content. Je voudrais juste la compléter afin que la nouvelle copie que je veux sauvegarder dans le fichier dont le chemin est indiqué vienne remplacer la sauvegarde précédente au lieu de s'y ajouter (au bout d'un moment, le dossier est "encombré".

J'ai pensé à 2 possibilités :
- soit la nouvelle sauvegarde remplace automatiquement l'ancienne
- soit la boîte de dialogue qui me demande si je veux sauvegarder ce fichier me propose également si je veux que cette sauvegarde remplace la précédente ou pas.

Je prendrai celle qui me sera proposée.

Quelqu'un sait-il comment compléter la macro et à quel endroit insérer cette partie de code ?
Merci à tous ceux qui voudront bien m'aider.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim strDate As String, Fichier As String, Chemin As String
Msg = "Désirez-vous sauvegarder ce fichier ?"
Réponse = MsgBox(Msg, vbYesNo)
If Réponse = vbYes Then
strDate = Format(Date, "dd-mm-yy") & "_" & Hour(Time) & "h" & Minute(Time)
Fichier = Sheets("Menu").Range("E8")
Chemin = "\\Ventoux\Documents communs\CNDS\" & Fichier
If Dir(Chemin, vbDirectory) = "" Then MkDir Chemin 'crée le répertoire s'il n'existe pas
ActiveWorkbook.SaveAs Chemin & "\" & "fichier du_" & strDate & ".xlsm"
End If
End Sub

 

[JNP]

Re : compléter macro de sauvegarde de fichier

Bonjour David84

- soit la nouvelle sauvegarde remplace automatiquement l'ancienne
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim strDate As String, Fichier As String, Chemin As String
Msg = "Désirez-vous sauvegarder ce fichier ?"
Réponse = MsgBox(Msg, vbYesNo)
If Réponse = vbYes Then
strDate = Format(Date, "dd-mm-yy") & "_" & Hour(Time) & "h" & Minute(Time)
Fichier = Sheets("Menu").Range("E8")
Chemin = "\\Ventoux\Documents communs\CNDS\" & Fichier
If Dir(Chemin, vbDirectory) = "" Then MkDir Chemin 'crée le répertoire s'il n'existe pas
ActiveWorkbook.SaveAs Chemin & "\" & "fichier du_" & strDate & ".xlsm"
End If
End Sub

Si tu supprimes ce qui est en rouge, tu vas obtenir une seule sauvegarde, avec un nom unique, donc qui sera écrasée à chaque fois. Pour ne garder que quelques sauvegardes, le problème est de vérifier les dates des sauvegardes précédentes pour éliminer les plus vieilles, mais ça, c'est une autre histoire .
Bon courage

 

[david84]

Re : compléter macro de sauvegarde de fichier

Merci pour ta réponse JPN. Elle me convient en partie car j'aimerais cependant que la sauvegarde affiche dans son titre la date et l'horaire histoire que les autres personnes puissent voir de visu s'ils disposent de la dernière version.
J'ai mis dans la feuille "menu" en A2 la formule "maintenant" et j'ai essayé de l'incorporer dans le nom du fichier de la macro : Fichier = Sheets("Menu").Range("E8")
J'ai essayé différentes possibilités genre Fichier=Sheets("Menu").Range("E8").Range("A2"), mais sans succès...
Peut-être en essayant d'incorporer directement dans la macro la version VBA de la formule maintenant mais je ne la connais pas...
As-tu une idée ?

 

[JNP]

Re : compléter macro de sauvegarde de fichier

Re ,
C'est le serpent qui se mord la queue ...
Pour écraser un fichier, il faut qu'il porte le même nom, sinon, c'est un autre qui est créé... Et si c'est la date qui est incorporée dans le nom de fichier, le nom est différent !

Dim strDate As String, Fichier As String, Chemin As String
strDate = Format(Date, "dd-mm-yy") & "_" & Hour(Time) & "h" & Format(Minute(Time), "00")
Fichier = Sheets("Menu").Range("E8")
Chemin = "\\Ventoux\Documents communs\CNDS\" & Fichier
If Dir(Chemin, vbDirectory) = "" Then MkDir Chemin 'crée le répertoire s'il n'existe pas
If Dir(Chemin & "\*.xlsm") <> "" Then Kill Chemin & "\" & Dir(Chemin & "\*.xlsm")
ActiveWorkbook.SaveAs Chemin & "\" & "fichier du_" & strDate & ".xlsm"

devrait te convenir, vu qu'il jette le fichier dans la sauvegarde quand il sauvegarde la nouvelle. Ça ne fonctionnera que si il y a un seul fichier dans la sauvegarde, s'il y en a plusieurs, il n'en effacera qu'un seul (lequel ?).
Bon courage

 

[david84]

Re : compléter macro de sauvegarde de fichier

Merci JNP, c'est exactement ce que je voulais !

 

[david84]

Re : compléter macro de sauvegarde de fichier

Bonjour le forum,
après avoir testé à nouveau la macro, je m'aperçois que si j'oublie d'enregistrer les modif (bouton enregistrer) avant de fermer et que je sauvegarde le fichier, la sauvegarde est mise à jour mais pas le fichier en lui-même.Par contre, si je pense à enregistrer avant de sauvegarder, là pas de problème.
Quel complément apporter à la macro pour qu'elle me propose d'enregistrer les modifications avant (ou après) la proposition de sauvegarde ?
Merci de votre aide

 

[JNP]

Re : compléter macro de sauvegarde de fichier

Re ,
La même que pour la sauvegarde ...

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim strDate As String, Fichier As String, Chemin As String
Msg = "Désirez-vous enregistrer ce fichier ?"
Réponse = MsgBox(Msg, vbYesNo)
If Réponse = vbYes Then ActiveWorkbook.Save
Msg = "Désirez-vous sauvegarder ce fichier ?"
Réponse = MsgBox(Msg, vbYesNo)
If Réponse = vbYes Then
strDate = Format(Date, "dd-mm-yy") & "_" & Hour(Time) & "h" & Format(Minute(Time), "00")
Fichier = Sheets("Menu").Range("E8")
Chemin = "\\Ventoux\Documents communs\CNDS\" & Fichier
If Dir(Chemin, vbDirectory) = "" Then MkDir Chemin 'crée le répertoire s'il n'existe pas
If Dir(Chemin & "\*.xlsm") <> "" Then Kill Chemin & "\" & Dir(Chemin & "\*.xlsm")
ActiveWorkbook.SaveAs Chemin & "\" & "fichier du_" & strDate & ".xlsm"
End If
End Sub

mais ça va devenir un peu lourd pour les utilisateurs ...
Enfin, c'est toi qui vois .

 

[david84]

Re : compléter macro de sauvegarde de fichier

Je suis conscient de ta remarque, c'est pourquoi je cherche à alléger la procédure.
En fait, j'ai 3 fenêtres qui s'affichent à la suite :
- les 2 premières sont les boîtes de dialogue d'enregistrement et de sauvegarde du fichier demandé dans la macro, donc pas de pb
- la 3ème est une autre boite de dialogue me demandant si je veux enregistrer les modif apportées au fichier et celle-là, je n'en ai pas besoin car elle fait redondance avec la 1ère (et d'ailleurs je l'ai pas demandée dans la macro, elle apparaît automatiquement).
J'essaie donc de ne pas la faire apparaître en demandant à la macro de sortir de la boucle (les 2 "If réponse = vbNo Then Exit Sub").
Lorsque je clique sur "oui" pour enregistrer, puis "oui" ou "non" pour sauvegarder, pas de pb, la 3eme boite de dialogue n'apparaît plus.
Par contre, ce que je voudrais c'est si je clique sur "non" lorsque la boite de dialogue "voulez-vous enregistrer le fichier" s'ouvre que la macro s'arrête et que le fichier se ferme.
Mais ca je n'y arrive pas car la boite de dialogue me demandant si je veux enregistrer les modif apportées au fichier s'ouvre quand même.
J'ai pourtant placé dans la macro la demande "If réponse = vbNo Then Exit Sub".
Là je bloque... qu'est-ce qui ne va pas ?

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim strDate As String, Fichier As String, Chemin As String
Msg = "Désirez-vous enregistrer ce fichier ?"
réponse = MsgBox(Msg, vbYesNo)
If réponse = vbYes Then ActiveWorkbook.Save
If réponse = vbNo Then Exit Sub
Msg = "Désirez-vous sauvegarder ce fichier ?"
réponse = MsgBox(Msg, vbYesNo)
If réponse = vbNo Then Exit Sub
If réponse = vbYes Then
strDate = Format(Date, "dd-mm-yy") & "_" & Hour(Time) & "h" & Format(Minute(Time), "00")
Fichier = Sheets("Menu").Range("E8")
Chemin = "C:\Documents and Settings\DA\Mes documents\Bureau DDJS\CNDS et titre 6\CNDS 2010\" & Fichier
If Dir(Chemin, vbDirectory) = "" Then MkDir Chemin 'crée le répertoire s'il n'existe pas
If Dir(Chemin & "\*.xlsm") <> "" Then Kill Chemin & "\" & Dir(Chemin & "\*.xlsm")
ActiveWorkbook.SaveAs Chemin & "\" & "fichier du_" & strDate & ".xlsm"
End If
End Sub

 

[JNP]

Re : compléter macro de sauvegarde de fichier

Re ,
Ta macro est dans une événementielle "avant de fermer", le fait de "quitter la macro" ne changera rien... Le problème se situe au niveau du fonctionnement normal d'Excel qui demande si il faut enregistrer le fichier dès qu'il y a eut une modification. Comme la sauvegarde, tu viens de l'enregistrer, pas de problème. Si tu as accepté l'enregistrement, pas de problème non plus. Par contre, si tu as dit "non" aux 2 messages, par sécurité, il te demande si tu veux enregistrer .
Il te suffit donc de mettre en fin de macro

ThisWorkbook.Close SaveChanges:=False
End Sub

qui fermera le fichier sans demander son compte, ce qui n'est pas un problème, vu que les choix ont déjà été fait ...
Pour la lourdeur, le mieux serait de faire un USF avec plusieurs bouton : "Enregistrer et sauvegarder", "Enregistrer sans sauvegarder", "Sauvegarder sans enregistrer" et "Quitter sans enregistrer ni sauvegarder", ce qui ne ferait qu'un seul clic pour l'utilisateur .
Bon courage

 

[david84]

Re : compléter macro de sauvegarde de fichier

Re,
j'ai essayé d'incorporer le code que tu m'as indiqué en fin de macro, (avec ou sans
If réponse = vbNo Then Exit Sub) mais cela créé un bogue :
"Kill Chemin & "\" & Dir(Chemin & "\*.xlsm")" est surligné...

 

[JNP]

Re : compléter macro de sauvegarde de fichier

Re ,
C'est pas le .Close qui peut créer un bug au niveau du Kill...
Par contre, au départ, tu étais sur un serveur \\Ventoux\Documents communs\, maintenant t'es sur ton C:\, as-tu bien les droits d'effacement ? Le Kill ne peux pas beuguer vu qu'il ne se déclenche que si il y a un fichier...
Et vire tous les Exit Sub, ils n'ont rien à faire là...
Bon courage

 

[david84]

Re : compléter macro de sauvegarde de fichier

Re,
Bonsoir JPN,
j'ai refais les essais comme tu me l'as précisé et je t'assure qu'il bogue comme indiqué dans mon précédent message dès que j'inclus avant end sub :
ThisWorkbook.Close SaveChanges:=False
En fait je te décris ce qui se passe :
- quand je clique sur "oui" à l'apparition des 2 msg box lors de la fermeture du fichier d'origine, le doc de sauvegarde est alors automatiquement ouvert et me repropose les 2 msg box. C'est cela qui fait boguer la macro comme décrit précédement.
Je ne comprends pas pourquoi le doc de sauvegarde s'ouvre et je te précise que cela n'arrive pas si je n'incorpore pas en fin de macro
ThisWorkbook.Close SaveChanges:=False
Bonne nuit !

 

[JNP]

Re : compléter macro de sauvegarde de fichier

Re ,
Techniquement, c'est plutôt le contraire qui se passe... Quand tu fais un enregistrer sous, tu abandonnes le fichier ancien, sans sauvegarde, pour avoir un nouveau document à l'écran qui s'appelle avec son nouveau nom...
Donc effectivement, ce nouveau document, quand on le ferme, contient aussi la macro avant fermeture, d'où le bug...
Essaie

Application.EnableEvents = True
ActiveWorkbook.Close SaveChanges:=False
Application.EnableEvents = False

à la place.
Bonne soirée

 

[david84]

Re : compléter macro de sauvegarde de fichier

Bonjour JPN,
j'ai incorporé le bout de code entre end if et end sub mais cela ne règle pas le pb.
J'ai également essayé d'inverser ton code au cas où :
Application.EnableEvents = false
ActiveWorkbook.Close SaveChanges:=False
Application.EnableEvents = true
mais cela ne donne pas le résultat escompté.

J'ai également tenté de placer application.displayAlerts =false avant end sub mais sans succès.
Je continue à chercher de mon côté et te remercie de ton aide.
On va peut-être bien finir par trouver la solution !