Création sauvegarde et copie automatique VBA
Bonjour,
Tout d'abord je tiens à remercier par avances toutes les personnes qui m'aideront à solutionner mon problème.
Je suis actuellement en train de crée un fichier sous excel aux multiple fonctions mais étant totalement novice en VBA cela est très compliqué pour moi. Malgré tous chaque fois j'arrive grâce au multiple recherche sur votre forum ou bien même google à retomber sur mes pattes.
Mais si aujourd'hui je me permets de faire appel à vos connaissances car malgré les nombreuses heures écouler je n'arrive pas créé une macro.
Je vous explique mon problème j'aimerais créer une sauvegarde automatique de mon fichier suivant un temps renseigné dans une cellule. De plus je souhaite également qu'une copie de mon fichier soit sauvegardée à chaque fermeture suivant un chemin dans une cellule.
Je sais que cela peut paraître assez abstrait expliquer de la sorte c'est pour cela que je vous join un fichier qui sera beaucoup plus parlant.
Voici les pistes actuelles dont je dispose:
Pour la sauvegarde automatique du fichier suivant un temps:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Application.OnTime Now + TimeValue("00:00:05"), "EnregistrerFichier"
End Sub
Pour la sauvegarde automatique d'une copie du fichier dans un dossier :
Dim Chemin As String, Fichier As String
Chemin = Chemin & Range("G2").Value & "_" & ".xls"
'Ajoute la date du jour et l'heure dans le nom du fichier
Fichier = "NomClasseur_" & Format(Date, "yyyymmdd") & "_" & Format(Time, "hhmmss") & ".xls"
ActiveWorkbook.SaveCopyAs Chemin & Fichier
End SubBonjour Mabou, bonjour le forum,
Désactiver EnableEvents n'est pas une bonne idée. En effet dans ce cas, si tu fermes le classeur l'événementielle Workbook_BeforeClose sera tout simplement zappée...
Le code :
• Composant ThisWorkbook :
Private Sub Workbook_Open()
With Worksheets("Feuil1")
.Activate
.Shapes("Rectangle").Select
Selection.Characters.Text = "Marche"
.Range("G2").Value = ""
.Range("B1").Select
End With
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If TEST = False Then Exit Sub
T = TimeSerial(0, Worksheets("Feuil1").Range("A2").Value, 0)
Application.OnTime Now + TimeValue(T), "EnregistrerFichier"
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Chemin As String, Fichier As String
With Worksheets("Feuil1")
If .Range("G2").Value = "" Then
MsgBox "Vous devez renseigner le chemin d'accès !"
.Activate
.Range("G2").Select
Cancel = True
Exit Sub
End If
Chemin = .Range("G2").Value & "\"
End With
'Ajoute la date du jour et l'heure dans le nom du fichier
Fichier = Replace(ThisWorkbook.Name, ".xls", "")
Fichier = Fichier & "_" & Format(Date, "yyyymmdd") & "_" & Format(Time, "hhmmss") & ".xls"
ActiveWorkbook.SaveCopyAs Chemin & Fichier
End Sub• Module Module1 :
Public TEST As Boolean
Sub EnregistrerFichier()
ThisWorkbook.Save
End Sub
Sub Bouton1_Cliquer()
Dim FD As FileDialog
Set FD = Application.FileDialog(msoFileDialogFolderPicker)
With FD
.AllowMultiSelect = False
.Show
If .SelectedItems.Count = 0 Then Exit Sub
Worksheets("Feuil1").Range("G2").Value = .SelectedItems(1)
End With
End Sub• Composant Feuil1(Feuil1) :
Sub est()
ActiveSheet.Shapes("Rectangle").Select
Selection.Characters.Text = IIf(Selection.Characters.Text = "Marche", "Arrêt", "Marche")
If ActiveSheet.Shapes("Rectangle").TextFrame.Characters.Text = "Marche" Then
TEST = False
Else
TEST = True
End If
Range("B1").Select
End SubEn pièce jointe ton fichier modifié :
Salut ThauThème,
Merci beaucoup c'est exactement ce qu'il me fallait !
Le seul problème est qu'il faut cliquer sur le bouton marche arrêt pour que sa marche alors que le bouton lui affiche marche.
Je voulais savoir serait-il possible de faire sorte que le chemin d'accès pour la sauvegarde soit enregistré et qu’il ne faille pas faire parcourir à chaque ouverture ?
De plus comment faire pour ne pas avoir un message d'erreur qui empêche de fermer le fichier si rien n'est renseigné ?
Merci énormément de ton aide !
L'enregistrement automatique semblé ne plus fonctionne de plus si c'est possible il faudrait que quand il est mis sur la marche il le reste même après fermeture et réouverture du fichier. Pour le reste sa marche parfaitement.
Encore merci pour ton aide !
EDIT: Le bouton marche est inversé
Re,
La fonction Enregistrement toutes les X minutes est active à l'ouverture du classeur. Le bouton affiche Arrêt pour désactiver cette fonction. Dans ce cas il affichera Marche pour la réactiver. Il affiche systématiquement le contraire de la fonction !...
En pièce jointe la version 03. J'ai testé ça fonctionne. Vérifie dans le dossier les fichiers Mabou_date_heure.xls et tu verras...
Je t'avoue que je galère car avec Excel 2010 j'ai toujours un message quand je veux enregistrer avec une macro et avec l'extension .xls...
Désoler je n'avais pas compris pour le bouton.
Le fichier marche niquel pour moi merci beaucoup !
Dernière petite question tu crois qu'il est possible de supprimer la dernière sauvegarde quand une autre est créée pour ne pas avoir 100 fichiers.
Re,
Je ne sais pas si tu as ce problème chez toi ? Une fois le fichier d'origine fermé, son projet VBA (l'ensemble de ses macros) apparaît toujours dans VBE, l'éditeur VBA. Du coup ça me redemande d'enregistrer toutes les X minutes alors que le fichier est fermé ?!...
Je ne sais pas si c'est dû au fait que je suis sous Excel 2010 avec des fichier avec macros .xls et non pas .xlsm...
Quoiqu'il en soit, je te propose une nouvelle version de la macro du composant ThisWorkbook.
Mais il y a une chose que je ne comprends pas. Si tu enregistres dans des dossier différents, quel intérêt de vouloir supprimer les anciens fichiers. Le code que je te propose ne fera que la suppression du fichier dans le même dossier. Il ne va pas scanner ton disque dur pour trouver !... Fait une copie de l'original au cas où...
Le code :
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Chemin As String, Fichier As String
Dim F As String
With Worksheets("Feuil1")
If .Range("G2").Value = "" Then
MsgBox "Le chemin d'accès n'est pas renseigné, la copie ne sera pas effectuée !"
.Activate
.Range("G2").Select
Exit Sub
End If
Chemin = .Range("G2").Value & "\"
Fichier = Replace(ThisWorkbook.Name, ".xls", "")
F = Dir(Chemin & Fichier & "_*.xls")
Do While F <> ""
Kill Chemin & F: Exit Do
Loop
End With
'Ajoute la date du jour et l'heure dans le nom du fichier
Fichier = Fichier & "_" & Format(Date, "yyyymmdd") & "_" & Format(Time, "hhmmss") & ".xls"
ActiveWorkbook.SaveCopyAs Chemin & Fichier
End SubBonjour,
Non je n'enregistre seulement qu'a un seul endroit cependant cet endroit est susceptible de changer mais très rarement voir jamais donc ta solution me conviens parfaitement. Je n'ai pas vu de tel problème de mon coté je vais essayer le code dans les prochains jours au bouclage de mon fichier et je t'en dirais plus.
Bonjour,
J'ai bien réussi à adapter le code à mon projet un grand merci à toi et à l’ensemble du forum !
Re,
La fonction Enregistrement toutes les X minutes est active à l'ouverture du classeur. Le bouton affiche Arrêt pour désactiver cette fonction. Dans ce cas il affichera Marche pour la réactiver. Il affiche systématiquement le contraire de la fonction !...
En pièce jointe la version 03. J'ai testé ça fonctionne. Vérifie dans le dossier les fichiers Mabou_date_heure.xls et tu verras...
Je t'avoue que je galère car avec Excel 2010 j'ai toujours un message quand je veux enregistrer avec une macro et avec l'extension .xls...
Bonjour,
J'ai essayé le fichier joint,
Il s'enregistre dans le bon dossier avec le format de date mais uniquement lors de la fermeture du document, il n'enregistre pas de copies toutes les X minutes inscrit en A2?
Merci