Sauvegarde speciale

RDB

XLDnaute Occasionnel
Bonjour à tous


Je cherche à sauvegarder un travail 2 fois de cette manière :

1) La première sauvegarde dans le repertoire gestion heures, en même temps une copie de cette sauvegarde dans le répertoire sauvegarde.

Lorsque j'ai a ré-utiliser le fichier , je sauvegarde à nouveau ,l'opération 1 se refait mais efface let remplace le fichier de la sauvegarde du répertoire sauvegarde.

De manière a avoir en permanence sur mon disque dur .. toutes les fichiers de sauvegarde effectués dans le repertoire Gestion heures et un seul fichier copie dans le repertoire sauvegarde.

Cela me permet en cas de plantage de pouvoir continuer à travailler.

J'ai essayé avec une macro, mais le résultat n'est pas extraordinaire.

Avez-vous une solution à me proposer.

merci
 

Sylvie

XLDnaute Accro
Bonsoir RDB, le forum,

en ce Mardi, lendemain de Lundi, je viens chercher un peu de confraternité sur ton post RDB. ;)

Peux tu préciser si ce que tu décris tu le fais déjà un peu ou si c'est ce que tu cherches à faire
J'ai une petite macro au frigo, prête là tout de suite sans préavis, ni carence, qui me permet de sauvegarder un fichier dans un répertoire que j'ai déterminé et en tout état de cause, si ce fichier existe déjà, j'ai toujours le choix de remplacer le précédent fichier. Ce n'est pas ton cas de figure ?

A+
 

RDB

XLDnaute Occasionnel
bonsoir Sylvie40

Ta macro est la bienvenue.
Elle correspond à ma demande, puisqu'elle me permet de garder une précédente sauvegarde.

J'ai déjà travaillé sur une macro, mais elle ne me permet pas de vérifier l'existence d'une précédente saauvegarde. De plus sur le forum, j'ai trouvé une sauvegarde avec la date d'enregistrement lié au fichier..pas mal d'ailleurs.

@+

l'exemple prit sur forum


Sub EnregisterFichier()

Dim D As String 'déclare la variable D (Date système au format jjmmaa)
Dim N As String 'déclare la varaible N (nom complet du fichier sans l'extension)
Dim A As Long, toto As Boolean

'définit la variable D (format à adapter mais certains caractères sont interdits)
D = Format(Date, 'ddmmyy')

'définit la variable N (Left permet de retirer '.xls')
N = IIf(IsNumeric(Mid(ThisWorkbook.FullName, Len(ThisWorkbook.FullName) - 9, 6)), Left(ThisWorkbook.FullName, Len(ThisWorkbook.FullName) - 10), Left(ThisWorkbook.FullName, Len(ThisWorkbook.FullName) - 4))

'enregistre le classeur sous
ThisWorkbook.SaveAs (N & D)

'si le classeur s'appelait 'Test.xls' un copie de celui-ci s'appelera 'Test170705.xls
End Sub
 

Sylvie

XLDnaute Accro
Re bonsoir RDB,

peux tu nous apporter quelques précisions supplémentaires pour mieux comprendre ta problématique :
- chaque fois que tu modifies ton fichier toto.xls, tu souhaites que la nouvelle version soit sauvegardée dans 'gestion des heures' sous la forme toto.xls (avec ecrasement du précédent fichier) ou que ce fichier soit sauvegardé sous un nouveau nom avec la date par exemple ? (toto2472005.xls)
- par contre la copie existante dans le repertoire sauvegarde, quand doit elle etre modifiée ? jamais ? à chaque modification ?
:eek:

Eclaire nous et les forces cachées de ce forum t'éclaireront à leur tour (je fais ici un clin d'oeil à ceux qui m'aident en ce moment même à te répondre)

A+
 

RDB

XLDnaute Occasionnel
bonsoir

Je voudrais que lorsque je sauvegarde un fichier par exp toto celui-ci est sauvegardé dans gestion des heures sous la forme toto(la date) sans ecrasement du précédent et qu'une copie de ce fichier soit sauvegardée dans le répertoire Sauvegarde en écrasant l'ancien.

La nouvelle copie existante dans le repertoire Sauvegarde, n'est là qu'un cas de problème. Elle sera modifiée à chaque sauvegarde.

par exp : Opération Enregistrement =

c:\\gestion des heures\\ toto20juil2005.xls (les autres sauvegardes sont présentes°.

C;\\Sauvegarde\\toto20juil2005.xls (remplace toto30juin2005.xls)

@+
 

RDB

XLDnaute Occasionnel
bonsoir

Je voudrais que lorsque je sauvegarde un fichier par exp toto celui-ci est sauvegardé dans gestion des heures sous la forme toto(la date) sans ecrasement du précédent et qu'une copie de ce fichier soit sauvegardée dans le répertoire Sauvegarde en écrasant l'ancien.

La nouvelle copie existante dans le repertoire Sauvegarde, n'est là qu'un cas de problème. Elle sera modifiée à chaque sauvegarde.

par exp : Opération Enregistrement =

c:\\gestion des heures\\ toto20juil2005.xls (les autres sauvegardes sont présentes°.

C;\\Sauvegarde\\toto20juil2005.xls (remplace toto30juin2005.xls)

@+
 

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Bonjour Rdb, Sylvie40

Voici deux exemples de code
Enregistrer_Sous_Et_Sauvegarde: permet de choisir un emplacement, teste l'existence du fichier avant écrasement et demande confirmation, crée le répertoire de sauvegarde si celui ci n'existe pas, fait la sauvegarde.
Enregistrer_Et_Sauvegarde:enregistre le fichier à son emplacement actuel, crée le répertoire de sauvegarde si celui ci n'existe pas, fait la sauvegarde.

Cordialement, A+
Code:
Sub Enregistrer_Sous_Et_Sauvegarde()
    On Error GoTo Fin
    Application.DisplayAlerts = False
    Dim Titre_Box As String
    Dim Nom_Fichier As String, Nom_Fichier_2 As String
    Dim Test_Fichier As Integer, Compteur As Integer
    Titre_Box = 'Enregistrement et sauvegarde du Fichier'
    Nom_Fichier = ThisWorkbook.FullName
    Test_Fichier = 0
    Do
        Nom_Fichier = Application.GetSaveAsFilename(Nom_Fichier, FileFilter:='Fichiers Excel (*.Xls),*.Xls', Title:=Titre_Box)
        If Not (Dir$(Nom_Fichier, vbNormal) = '') Then Test_Fichier = MsgBox(LCase(Nom_Fichier) & ' existe déja' & Chr(10) & 'en date du ' & DateValue(FileDateTime(Nom_Fichier)) & Chr(10) & 'voulez vous l'écraser ?', vbYesNo + vbQuestion)
        If Test_Fichier = 7 Then Titre_Box = 'Redéfinissez le nom d'enregistrement'
        If Nom_Fichier = 'Faux' Then MsgBox 'Fichier non enregistré !', vbOKOnly + vbExclamation: Exit Sub
    Loop While Test_Fichier = 7
    'test répertoire de sauvegarde
    Compteur = InStrRev(Nom_Fichier, '\\', Len(Nom_Fichier), 1)
    If Dir$(Left(Nom_Fichier, Compteur) & 'Sauvegarde', vbDirectory) = '' Then MkDir Left(Nom_Fichier, Compteur) & 'Sauvegarde'
    'définition du nom de fichier de sauvegarde
    Nom_Fichier_2 = Right(Nom_Fichier, Len(Nom_Fichier) - Compteur)
    Nom_Fichier_2 = Left(Nom_Fichier_2, InStrRev(Nom_Fichier_2, '.', Len(Nom_Fichier_2), 1) - 1) & Format(Now(), 'ddmmyyyy') & Right(Nom_Fichier_2, Len(Nom_Fichier_2) - (InStrRev(Nom_Fichier_2, '.', Len(Nom_Fichier_2), 1) - 1))
    Nom_Fichier_2 = Left(Nom_Fichier, Compteur) & 'Sauvegarde\\' & Nom_Fichier_2
    ThisWorkbook.SaveAs Filename:=Nom_Fichier
    ThisWorkbook.SaveCopyAs Filename:=Nom_Fichier_2
    MsgBox 'Fichier enregistré sous ' & Nom_Fichier & Chr(10) & 'Sauvegarde enregistrée sous ' & Nom_Fichier_2, vbOKOnly + vbInformation
    Exit Sub
Fin:
    MsgBox 'Un problème est survenu pendant la sauvegarde', vbOKOnly + vbCritical
End Sub
Sub Enregistrer_Et_Sauvegarde()
    On Error GoTo Fin
    Application.DisplayAlerts = False
    Dim Nom_Fichier As String, Nom_Fichier_2 As String
    Dim Compteur As Integer
    Nom_Fichier = ThisWorkbook.FullName
    'test répertoire de sauvegarde
    Compteur = InStrRev(Nom_Fichier, '\\', Len(Nom_Fichier), 1)
    If Dir$(Left(Nom_Fichier, Compteur) & 'Sauvegarde', vbDirectory) = '' Then MkDir Left(Nom_Fichier, Compteur) & 'Sauvegarde'
    'définition du nom de fichier de sauvegarde
    Nom_Fichier_2 = Right(Nom_Fichier, Len(Nom_Fichier) - Compteur)
    Nom_Fichier_2 = Left(Nom_Fichier_2, InStrRev(Nom_Fichier_2, '.', Len(Nom_Fichier_2), 1) - 1) & Format(Now(), 'ddmmyyyy') & Right(Nom_Fichier_2, Len(Nom_Fichier_2) - (InStrRev(Nom_Fichier_2, '.', Len(Nom_Fichier_2), 1) - 1))
    Nom_Fichier_2 = Left(Nom_Fichier, Compteur) & 'Sauvegarde\\' & Nom_Fichier_2
    ThisWorkbook.SaveAs Filename:=Nom_Fichier
    ThisWorkbook.SaveCopyAs Filename:=Nom_Fichier_2
    MsgBox 'Fichier enregistré sous ' & Nom_Fichier & Chr(10) & 'Sauvegarde enregistrée sous ' & Nom_Fichier_2, vbOKOnly + vbInformation
    Exit Sub
Fin:
    MsgBox 'Un problème est survenu pendant la sauvegarde', vbOKOnly + vbCritical
End Sub

[file name=Exemple_enregistrement.zip size=11059]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Exemple_enregistrement.zip[/file]

Message édité par: yeahou, à: 20/07/2005 07:29
 

Pièces jointes

  • Exemple_enregistrement.zip
    10.8 KB · Affichages: 18

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Re bonjour

je rajoute également ce code qui fait uniquement la sauvegarde
Code:
Sub Sauvegarde_Seule()
    On Error GoTo Fin
    Application.DisplayAlerts = False
    Dim Nom_Fichier As String, Nom_Fichier_2 As String
    Dim Compteur As Integer
    Nom_Fichier = ThisWorkbook.FullName
    'test répertoire de sauvegarde
    Compteur = InStrRev(Nom_Fichier, '\\', Len(Nom_Fichier), 1)
    If Dir$(Left(Nom_Fichier, Compteur) & 'Sauvegarde', vbDirectory) = '' Then MkDir Left(Nom_Fichier, Compteur) & 'Sauvegarde'
    'définition du nom de fichier de sauvegarde
    Nom_Fichier_2 = Right(Nom_Fichier, Len(Nom_Fichier) - Compteur)
    Nom_Fichier_2 = Left(Nom_Fichier_2, InStrRev(Nom_Fichier_2, '.', Len(Nom_Fichier_2), 1) - 1) & Format(Now(), 'ddmmyyyy') & Right(Nom_Fichier_2, Len(Nom_Fichier_2) - (InStrRev(Nom_Fichier_2, '.', Len(Nom_Fichier_2), 1) - 1))
    Nom_Fichier_2 = Left(Nom_Fichier, Compteur) & 'Sauvegarde\\' & Nom_Fichier_2
    ThisWorkbook.SaveCopyAs Filename:=Nom_Fichier_2
    MsgBox 'Sauvegarde enregistrée sous ' & Nom_Fichier_2, vbOKOnly + vbInformation
    Exit Sub
Fin:
    MsgBox 'Un problème est survenu pendant la sauvegarde', vbOKOnly + vbCritical
End Sub

Message édité par: yeahou, à: 20/07/2005 07:27
 

Discussions similaires

Statistiques des forums

Discussions
312 333
Messages
2 087 375
Membres
103 529
dernier inscrit
gonzi