Sauvegarde auto
Le
man77
Hors ligne
Bonjour à Tous,
J'aurais besoin d'aide.
Etant débutant en VBA, pourriez-vous m'aider à créer un bouton de sauvegarde auto du fichier actif sous un autre répertoire. Je souhaiterais que cette sauvegarde s'effectue tous les 100 jour avec alerte (rouge par exemple) et validation manuelle.
J'espère être simple et clair
Bouton de sauvegarde avec alerte, compteur et validation.
Merci à tous pour votre aide
@++
J'aurais besoin d'aide.
Etant débutant en VBA, pourriez-vous m'aider à créer un bouton de sauvegarde auto du fichier actif sous un autre répertoire. Je souhaiterais que cette sauvegarde s'effectue tous les 100 jour avec alerte (rouge par exemple) et validation manuelle.
J'espère être simple et clair
Bouton de sauvegarde avec alerte, compteur et validation.
Merci à tous pour votre aide
@++
Ceci crée un répertoire nommé "Sauvegarde" dans le chemin du fichier en cours à son 1er lancement et y place
une copie du fichier en cours.
Contrôle à chaque ouverture si une nouvelle sauvegarde est nécessaire
Dans le thisWorkbook
'----------------
Private Sub Workbook_Open()
Call sauvegarde
End Sub
"----------------
Dans un module standard
'--------------------------
Sub sauvegarde()
Dim Repertoire As String, Fichier As String, nom As String
Repertoire = ThisWorkbook.Path & "Sauvegarde"
nom = "Sauvegarde de " & ThisWorkbook.Name & " du " & Format(Now, "dd mm yyyy hh_mm_ss") & ".xls"
If Dir(Repertoire, 16) = "" Then
MkDir Repertoire
ThisWorkbook.SaveCopyAs Repertoire & nom
End If
'----------
Fichier = Dir(Repertoire)
If Date - CDate(Left(Right(Fichier, 23), 10)) >= 100 Then
If MsgBox("La date de sauvegarde de votre fichier est périmée." & vbLf & "Voulez-vous procéder à une
nouvelle sauvegarde", 292, "Information") = 6 Then
Kill Repertoire & Fichier
ThisWorkbook.SaveCopyAs Repertoire & nom
End If
End If
End Sub
'----------------------
--
Salutations
JJ
"man77"
Bonjour Jacky et merci de ta réponse.
En fait je souhaite que ts les xèm jour une alerte apparaisse dans mon bouton pour informer l'utilisateur qu'i doit faire une sauvegarde. Cette sauvegarde doit s'effectuer dans un répertoire différent de l'utilisé et doit contenir la date de la sauvegarde.
merci de ton aide
@+
C'est le cas, et cela est paramétrable par
If Date - CDate(Left(Right(Fichier, 23), 10)) >= 100
100 étant le nombre de jour demandé
Le fichier est sauvegardé avec la date et l'heure de sauvegarde dans son nom
Pour ce qui est du répertoire de sauvegarde ceci aussi est paramétrable
Par défaut et automatique, j'avais ceci
Repertoire = ThisWorkbook.Path & "Sauvegarde"
Ce qui est facilement modifiable.
Bon courage
--
Salutations
JJ
"man77"
Merci Jacky,
L'enregistrement s'effectue bien dans un fichier sauvegarde. arfait.
Est-il possible d'ajouter un voyant, une alerte un signal indiquant le temps avnt la prochaine sauvegarde.
Merci pour ton aide.
@+
Une alerte a l'ouverture du classeur....
Modifier cette partie du code
'----------------
Fichier = Dir(Repertoire)
If Date - CDate(Left(Right(Fichier, 23), 10)) >= 100 Then
If MsgBox("La date de sauvegarde de votre fichier est perimée." & vbLf & "Voulez-vous procéder à une
nouvelle sauvegarde", 292, "Information") = 6 Then
Kill Repertoire & Fichier
ThisWorkbook.SaveCopyAs Repertoire & nom
End If
Else
MsgBox "Il reste " & 100 - (Date - CDate(Left(Right(Fichier, 23), 10))) & " jour(s) avant la prochaine
sauvegarde"
' Msgbox peut -être remplacer par une adresse de cellule
End If
End Sub
'--------------------------
Attention, les messages répétitifs deviennent vite rébarbatifs
--
Salutations
JJ
Ps:La roulette de ma souris, moi et bien d'autres remercions les questionneurs
de répondre au-dessus des messages
(c'est la coutume sur ce forum)
merci et bon WE.
Je teste et je reviens au cas ou.
Désolé pour la souris...lol...
@++
Bonjour et merci.
Problème résolu et ça fonctionne parfaitement.
@++ pour de nouvelles programmation.
Bonjour,
De nouveau besoin d'aide.
Après plusieurs tests ça ne fonctionne pas.
Peux-tu m'aider stp :
Sub sauvegarde()
Repertoire = "R:Technique-MaintenanceSauvegarde"
nom = "Sauvegarde de " & ThisWorkbook.Name & " du " & Format(Now, "dd mm yyyy") & ".xls"
If Dir(Repertoire, 16) = "" Then
MkDir Repertoire
ThisWorkbook.SaveCopyAs Repertoire & nom
End If
'----------
Fichier = Dir(Repertoire)
If Date - CDate(Left(Right(Fichier, 23), 10)) >= 90 Then
If MsgBox("La date de sauvegarde de votre fichier est périmée." & vbLf & "Voulez-vous procéder à une nouvelle sauvegarde", 292, "Information") = 6 Then
Kill Repertoire & Fichier
ThisWorkbook.SaveCopyAs Repertoire & nom
End If
Else
[e13] = "Il reste " & 90 - (Date - CDate(Left(Right(Fichier, 23), 10))) & " jour(s) avant la prochaine sauvegarde AUTO "
End If
End Sub
Le problème est au niveau de cdate et du Kill...
Merci et @++
Peut-être en remplaçant :
ThisWorkbook.SaveCopyAs Repertoire & nom
par :
ThisWorkbook.SaveCopyAs Repertoire & "" & nom
Cordialement.
Daniel
Le répertoire " Technique-Maintenance" est -il existant ?
Si Oui essaye comme ceci
'----------------
Sub sauvegarde()
Repertoire = "R:Technique-MaintenanceSauvegarde"
nom = "Sauvegarde de " & ThisWorkbook.Name & " du " & Format(Now, "dd mm yyyy") & ".xls"
If Dir(Repertoire, 16) = "" Then
MkDir Repertoire
ThisWorkbook.SaveCopyAs Repertoire & nom
End If
'------------
fichier = Dir(Repertoire)
If Date - CDate(Left(Mid(fichier, Len(ThisWorkbook.Name) + 19, Len(ThisWorkbook.Name)), 10)) > 90 Then
If MsgBox("La date de sauvegarde de votre fichier est périmée." & vbLf & _
"Voulez-vous procéder à une nouvelle sauvegarde", 292, "Information") = 6 Then
Kill Repertoire & fichier
ThisWorkbook.SaveCopyAs Repertoire & nom
End If
Else
[e13] = "Il reste " & 90 - (Date - CDate(Left(Mid(fichier, Len(ThisWorkbook.Name) + 19,
Len(ThisWorkbook.Name)), 10))) _
& " jour(s) avant la prochaine sauvegarde AUTO "
End If
End Sub
'------------
Sinon quel est le chemin complet du fichier en cours ?
--
Salutations
JJ
"man77"