macro enregistrement automatique

[bobafric]

Bonjour à tous

J'ai une macro, ci-dessous,pour enregistrer automatiquementmon classeur toutes les 5 mn dans un dossier c:\22.
Le problème c'est que les enregistrements s'accumulent dans le dossier et je n'ai besoin que du dernier enregistrement ou à la rigueur des 3 derniers.
Que dois-je rajouter à ma macro pour que cela s'exécute automatiquement.

Private Sub Workbook_Open()

debut:

Start = Timer
intervalle = 300

Do While Timer < Start + intervalle
DoEvents ' Donne le contrôle à d'autres processus.
Loop

ChDir "C:\22\"

fname = "TEST - " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & " - " & Hour(Time) & "H" & Minute(Time) & "m" & Second(Time) & "s"

ActiveWorkbook.SaveAs Filename:=fname

GoTo debut

End Sub

Merci d'avance pour votre précieuse aide

Bob

 

[JNP]

Re : macro enregistrement automatique

Bonjour Bobafric ,
Si tu ne traite que ce fichier et ses copies dans ce dossier, tu peux effacer les autres par un Kill (à manipuler avec précaution ). Maintenant, pour savoir quels sont les fichiers à garder, tu peux soit passer par un Dir() puis Dir, afin de lister les fichier, les mettre dans un tableau, et par une savante équation (vu que tu es en notation française, càd jour-mois-année, en plus non formatée...) déterminer les 1, 2 ou 3 fichiers les plus récents. Si tu changes ta notation en

fname = "TEST - " & Format(Year(Date), "0000") & "-" & Format(Month(Date), "00") & "-" & _
Format(Day(Date), "00") & " - " & Format(Hour(Time), "00") & "H" & Format(Minute(Time), "00") & "m"

la comparaison alphanumérique suffira .
Soit passer par la déclaration d'un objet pour tes fichier et regarder la date de création.
Bon courage
Ajout : J'ai supprimé les secondes, vu que c'est abérent pour un enregistrement automatique toutes les 5 mn...

 

[bobafric]

Re : macro enregistrement automatique

Salut JPN
Merci pour ta réponse, mais ta solution 1ère ne supprime pas les fichiers antérieurs, et pour le reste je n'ai pas compris ce qu'il faut faire pour garder les 3 derniers.
Faut avouer que je suis zéro dans la programmation
A plus Bob

 

[JNP]

Re : macro enregistrement automatique

Re ,
Quelqu'un peut-il enfin retenir que je suis JNP et non JPN ?
Bon, après pas mal de tatonnements, car ce n'est pas la plus évidente des manipulations de VBA, essaie ce code, il devrait te donner satisfaction

Dim I As Integer, Start As Date, Intervalle As Date, FName As String
debut:
Start = Timer
Intervalle = [B][COLOR=red]10[/COLOR][/B]
Do While Timer < Start + Intervalle
DoEvents ' Donne le contrôle à d'autres processus.
Loop
FName = "C:\22\TEST - " & [COLOR=red][B]Format(I, "000")[/B][/COLOR]
ActiveWorkbook.SaveAs Filename:=FName
I = I + 1
Dim f As String, Tableau(), J As Integer
J = 1
f = Dir("C:\22\*.xls")
ReDim Preserve Tableau(J)
Tableau(J) = f
'f = Dir
While Left(f, 4) = "TEST"
J = J + 1
ReDim Preserve Tableau(J)
f = Dir
If Left(f, 4) = "TEST" Then
Tableau(J) = f
End If
Wend
If UBound(Tableau) > 2 Then
Dim K As Integer
For K = 1 To UBound(Tableau) - 4
Kill "C:\22\" & Tableau(K)
Next K
ReDim Tableau(1)
J = 0
End If
GoTo debut

tu peux, après l'avoir testé, rechanger les zones en rouge avec 300 (mes tests sur 10 secondes étaient plus rapides ) et les données de dates. Ça devrait fonctionner.
ATTENTION : NE LAISSE AUCUN FICHIER DANS LE DOSSIER 22, IL SERA AUTOMATIQUEMENT SUPPRIMÉ SANS AUCUNE POSSIBILITÉ DE RÉCUPÉRATION !
Bon courage

 

[bobafric]

Re : macro enregistrement automatique (résolu)

Merci JNP "pas trompé cette fois"
Ta solution est excellente je l'a met en application tout de suite.
A plus Bob

 

[JNP]

Re : macro enregistrement automatique

Re ,
Je préfère te répondre sur le fil, nos échanges peuvent servir à d'autres .

J'ai donc installé la macro qui fonctionne (dans ThisWorkbook), le problème c'est qu'on ne peut pas la rectifiée lorsqu'elle a fonctionné, et qu'on ne peut plus ouvrir aucun classeur excel tant que celui où est installé la macro est ouvert.

Je pense que le problème, c'est qu'une macro, même en laissant la main régulièrement, est toujours active. Il faudrait voir tes besoins réels. Est-ce que l'enregistrement automatique est vraiment nécessaire tous les 5 mn ? Ne peux-t-on pas plutôt mettre une événementielle, qui, au changement d'onglet par exemple, ferait la sauvegarde si 5 mn se sont écoulées depuis la dernière fois. Ou à chaque sélection ? Pour cela, tu peux déclarer une variable publique, la charger avec Timer dans ThisWorkbook_Open, puis dans l'événementielle, comparer cette variable avec Timer. Si moins de 5 mn, rien, sinon, sauvegarde + chargement de Timer dans la variable.
Bonne journée

 

[bobafric]

Re : macro enregistrement automatique

Si on met une évènementielle, peut-on par exemple enregistrer le classeur au bout de x minutes lorsqu'on entre une donnée si cela fait plus de x minutes que la dernière est entrée.Pour les onglets ça ne serait pas valable car on en change pas souvent.
Merci bob

 

[JNP]

Re : macro enregistrement automatique

Re ,
Je n'ai pas testé mais logiquement, dans ThisWorkbook

Private Sub Workbook_Open()
Public Début As Time
Début = Timer
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Début - Timer > 300 Then
Call EnregistrementSous
Début = Timer
End If
End Sub

devrait le faire si tu appelles ta macro d'enregistrement EnregistrementSous
Bonne soirée

 

[bobafric]

Re : macro enregistrement automatique

Salut JNP, excuse-moi de répondre à peine, mais j'ai dû lacher un peu mon ordi ces derniers jours.
J'ai essayé ton code, que j'ai collé dans thisworkbook
Résultat la fenêtre avec le message ci-dessous

Erreur de compilation
Attribut incorrect dans une procédure Sub ou Function

Mais je n'ai pas compris ta phrase:devrait le faire si tu appelles ta macro d'enregistrement EnregistrementSous

Comment et où dois-je nommer la macro EnregistrementSous

Merci encore pour ta patience
Bob

 

[JNP]

Re : macro enregistrement automatique

Re ,
Le Call appelle la sub d'enregistrement et d'effacement des anciens fichiers, donc il faut mettre dans un module la sub suivante

Sub EnregistrerSous()
Dim I As Integer, FName As String
ChDir "C:\22\"
FName = "TEST - " & Format(Year(Date), "0000") & "-" & Format(Month(Date), "00") & "-" & _
Format(Day(Date), "00") & " - " & Format(Hour(Time), "00") & "H" & Format(Minute(Time), "00") & "m"
ActiveWorkbook.SaveAs Filename:=FName
I = I + 1
Dim f As String, Tableau(), J As Integer
J = 1
f = Dir("C:\22\*.xls")
ReDim Preserve Tableau(J)
Tableau(J) = f
While Left(f, 4) = "TEST"
J = J + 1
ReDim Preserve Tableau(J)
f = Dir
If Left(f, 4) = "TEST" Then
Tableau(J) = f
End If
Wend
If UBound(Tableau) > 2 Then
Dim K As Integer
For K = 1 To UBound(Tableau) - 4
Kill "C:\22\" & Tableau(K)
Next K
ReDim Tableau(1)
J = 0
End If
End Sub

que j'ai recomposé d'après nos précédents posts, mais que je n'ai pas testé...
Bon courage

 

[bobafric]

Re : macro enregistrement automatique

Resalut JNP
Je ne peux pas essayer ton code car j'ai toujours un message d'erreur.
Je te détaille ci-dessous la procédure que j'utilise.
Dans ThisWorkbook je copie:
Private Sub Workbook_Open()
Public Début As Time
Début = Timer
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Début - Timer > 300 Then
Call EnregistrementSous
Début = Timer
End If
End Sub

Dans le module 1 :
Sub EnregistrerSous()
Dim I As Integer, FName As String
ChDir "C:\22\"
FName = "TEST - " & Format(Year(Date), "0000") & "-" & Format(Month(Date), "00") & "-" & _
Format(Day(Date), "00") & " - " & Format(Hour(Time), "00") & "H" & Format(Minute(Time), "00") & "m"
ActiveWorkbook.SaveAs Filename:=FName
I = I + 1
Dim f As String, Tableau(), J As Integer
J = 1
f = Dir("C:\22\*.xls")
ReDim Preserve Tableau(J)
Tableau(J) = f
While Left(f, 4) = "TEST"
J = J + 1
ReDim Preserve Tableau(J)
f = Dir
If Left(f, 4) = "TEST" Then
Tableau(J) = f
End If
Wend
If UBound(Tableau) > 2 Then
Dim K As Integer
For K = 1 To UBound(Tableau) - 4
Kill "C:\22\" & Tableau(K)
Next K
ReDim Tableau(1)
J = 0
End If
End Sub

Lorsque j'ouvre mon classeur, j'ai le message suivant:
"Erreur de compilation
Attribut incorrect dans une procédure Sub ou Function"

et dans visual basic,
Private Sub Workbook_Open()
Public Début As Time
l'attribut Public est surligné en bleu

Qu'est ce que je fais pas bien ?????

Merci et à plus Bob

 

[JNP]

Re : macro enregistrement automatique

Re ,
Désolé, j'ai fait 2 erreurs ...
1) Public doit être en dehors d'une procédure, et il me semble dans un module (et non ThisWorkBook), et surtout avant les procédures.
2) Si je Call EnregistrementSous mais que j'appelle ma procédure EnregistrerSous, ça le fait pas vraiment...
D'où

Dans ThisWorkbook je copie:
[B][COLOR=red]Private Sub Workbook_Open()[/COLOR][/B]
[B][COLOR=red]Début = Timer[/COLOR][/B]
End Sub

et

Dans le module 1 :
[COLOR=red][B]Public Début As Time[/B][/COLOR]
[B][COLOR=red]Sub EnregistrementSous()[/COLOR][/B]
Dim I As Integer, FName As String

Essaie avec ces corrections et tient moi au courant.
Bon courage

 

[bobafric]

Re : macro enregistrement automatique

RE RE
Lorsque j'ouvre le classeur je tombe sur le message dans VB:
Message
Erreur de compilation:
Type défini par l'utilisateur non défini

Public Début As Time
Debut as time est surligné

Pardon pour cse efforts

 

[JNP]

Re : macro enregistrement automatique

Re ,
Désolé, il est vraiment temps que je prenne des vacances ...
Time n'est pas un type de donnée, c'est Date qui est correct (qu'on avait d'ailleurs au début de ce fil...)

Public Début As [B][COLOR=red]Date[/COLOR][/B]

On va finir par y arriver !
Bon courage

 

[Pierrot93]

Re : macro enregistrement automatique

Bonjour Bobafric, JNP

pas tout suivi, mais si je peux me permettre, je préférerais sans doute une variable de type "Single" dans ce cas :

Dim debut As Single

la fonction "Timer" renvoyant une donnée de ce type, cf aide vba :

Renvoie une valeur de type Single représentant le nombre de secondes écoulées depuis minuit.

bonne journée.
@+