XL 2016 enregistrer sur le bureau chaque 5mn classeur actif sous son nom +1

[Usine à gaz]

Bonjour à toutes et à tous,

Afin d'éviter ou de réduire les risques de pertes de données saisies, je voudrais faire ce qui suit :

Enregistrement automatique chaque 5 mn (ou à paramétrer selon besoin) du fichier sous un autre nom
actuellement : nom du fichier = valeur A1

J'ai relevé le code sur : https://forum.excel-pratique.com/viewtopic.php?t=18819 que je remercie au passage

Le code enregistre dans "mes documents"
J'ai besoin que l'enregistrement se fasse sur le bureau de l'ordinateur (ou autre nom du bureau, quel que soit l'ordinateur)

D'autre part et si possible LOL
en remplacement des codes : Range("b1").Value = Range("b1").Value + 1 et [a1] = "=""enregistrement""&RC[1]"
qui m'obligent à occuper 2 cellules (a1 et b1) de ma feuille … est-il possible d'écrire un code qui enregistre directement sous le nom du classeur actif +1
J'ai cherché et fait des tests sans meilleure réussite.

Comme d'hab, je fais appel à votre expertise pour une solution qui m'arrangerait bien
Je joins le fichier test paramétré pour tests toutes les 10 secondes.

Un grand merci une fois de plus à toutes et à tous,
Amicalement,
Lionel,

 

[Usine à gaz]

Bonjour Calvus,

Merci pour ta réponse,
Je vois ça dès que j'ai un moment

 

[Usine à gaz]

Re-Calvus,

Merci ça marche
Je n'aurais pas trouvé,
Bon dimanche
lionel,

 

[laurent950]

Bonsoir Lionel, Gérard, Clavus, le forum,

découpage :
Nom du fichier sans la valeur numérique et la valeur numérique
pour l’enregistrement et l'incrémentation

Sub test()
' Trouve le non du fichier (complet)
    MsgBox ThisWorkbook.Name

' Trouver l'extension du fichier
    MsgBox Split(ThisWorkbook.Name, ".")(1)

' Trouve le non du fichier (sans l'extension)
    MsgBox Split(ThisWorkbook.Name, ".")(0)

' Trouve une valeur numérique (dans le nom du fichier "sans l'extension")
Dim i As Integer
Dim c As String
Dim temp As String
Dim NumChaine As Integer

    For i = 1 To Len(Split(ThisWorkbook.Name, ".")(0))
        c = Mid(Split(ThisWorkbook.Name, ".")(0), i, 1)
        If c >= "0" And c <= "9" Or c = "." Then temp = temp & c
    Next i
    NumChaine = Val(temp)
    MsgBox NumChaine

' Trouve le non du fichier sans la valeur numérique (suppression de la valeur numérique dans le nom du fichier "sans l'extension")
MsgBox Left(Split(ThisWorkbook.Name, ".")(0), Len(Split(ThisWorkbook.Name, ".")(0)) - Len(NumChaine))

' Incremetation du Numéréro du fichier + 1 (Nom du fichier + l'ancienne valeur numérique incrémenté de +1 chiffre)
Dim NouveauNomFichier As String
NouveauNomFichier = Left(Split(ThisWorkbook.Name, ".")(0), Len(Split(ThisWorkbook.Name, ".")(0)) - Len(NumChaine)) & NumChaine + 1
MsgBox NouveauNomFichier

' soit en remplacement par une variable (du nombre de caractère du fichier sans sa valeur numérique)
' ThisWorkbook.SaveAs ThisWorkbook.Path & "\enregistrement" & Val(Mid(ThisWorkbook.Name, 15)) + 1
' Entre crochet ' ThisWorkbook.SaveAs ThisWorkbook.Path & ["\enregistrement" & Val(Mid(ThisWorkbook.Name, 15)) + 1]
' par
' ' Entre crochet ' ThisWorkbook.SaveAs ThisWorkbook.Path & NouveauNomFichier

' ici
MsgBox Val(Mid(ThisWorkbook.Name, 15)) - 3
MsgBox Val(Mid(ThisWorkbook.Name, Len(NouveauNomFichier) - 1)) - 3
' Kill ThisWorkbook.Path & ["\enregistrement" & Val(Mid(ThisWorkbook.Name, 15))] - 3 & ".xlsm"
' Kill ThisWorkbook.Path & NouveauNomFichier - 3 & ".xlsm"
End Sub

cdt

 

[Usine à gaz]

Bonjour Laurent950, Gérard, Clavus, le forum,

@laurent950,
Merci pour ton code, je testerai et je te dirai
Bon dimanche,
lionel,

 

[Usine à gaz]

Bonjour Gérard, Laurent950, Clavus, le forum,
@Gérard,

J'étudie la meilleure façon de renommer le classeur pour visualisation par mes commerciales.

C'est pourquoi j'ai préféré un affichage du jour, heure, minutes et secondes au bout du nom.
Ce qui devrait donner : enregistrement_14-07-19_15-41-45

Mais j'ai 2 soucis :
1 - Il renomme avec un "0" : enregistrement0_14-07-19_15-41-45 que je n'arrive pas à enlever,
code tel que je l'ai modifié :
ThisWorkbook.SaveAs ThisWorkbook.Path & "\enregistrement" & Val(Mid(ThisWorkbook.Name, 14)) & "_" & Format(Date, "dd-mm-yy") & "_" & Format(Time, "hh-mm-ss")

2 - je n'arrive pas à trouver comment coder pour qu'il ne garde que 2 fichiers renommés et sauvegardés :
code : Kill ThisWorkbook.Path & "\enregistrement" & Val(Mid(ThisWorkbook.Name, 14)) - ??? & ".xlsm"

si pas possible, tant pis, je mettrait en place le code nom+1.
Je pense que c'est la dernière fois que je reviens sur le code LOL

Intenses remerciements
lionel,

 

[job75]

Bonjour Lionel, le fil,

Je pense que c'est la dernière fois que je reviens sur le code LOL

Il ne faut jurer de rien

Vois le fichier joint et le code de Module1 :

Public t# 'mémorise la variable

Sub Enregistrer()
Dim chemin$, fichier$, a(), n&
chemin = ThisWorkbook.Path & "\"
ThisWorkbook.SaveAs chemin & "enregistrement " & Format(Now, "dd-mm-yy hh-mm-ss")
On Error Resume Next
Application.OnTime t, "Enregistrer", , False
t = Now + 5 / 1440 'délai de 5 minutes
Application.OnTime t, "Enregistrer"
fichier = Dir(chemin & "enregistrement*.xlsm")
While fichier <> ""
    ReDim Preserve a(n) 'base 0
    a(n) = CDate(Mid(fichier, 16, 9) & Replace(Mid(fichier, 25, 8), "-", ":"))
    If a(n) <> "" Then n = n + 1
    fichier = Dir
Wend
tri a, 0, UBound(a)
'---on ne garde que les 2 derniers fichiers---
For n = 0 To UBound(a) - 2
    Kill chemin & "enregistrement " & Format(a(n), "dd-mm-yy hh-mm-ss") & ".xlsm"
Next
End Sub

Sub tri(a, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub

A+

 

[Usine à gaz]

LOL c'est vrai
Merci Gérard, je vais tester
@+

 

[Usine à gaz]

Merci Gérard,
c'est nickel

 

[Usine à gaz]

Bonjour Gérard, Laurent950, Calvus, le forum,

@job75 Gérard
"Je pense que c'est la dernière fois que je reviens sur le code LOL "
Il ne faut jurer de rien ... et tu avais raison

Je ne voulais pas te prendre plus temps mais j'y reviens encore une fois car je suis perdu
Le code fonction bien ... évidemment

Voilà :
J'ai besoin de personnaliser le nom de chaque classeur par commerciale (1 classeur = 1 commerciale)
par exemple : "\Charlotte_isitelImmobProspection"
ton code précédent était plus simple
et Calvus m'avait donné la solution pour modifier en fonction du nombre de caractères ce qui avait donné :
ThisWorkbook.SaveAs ThisWorkbook.Path & "\Charlotte_isitelImmobProspection" & Val(Mid(ThisWorkbook.Name, 33)) + 1
Kill ThisWorkbook.Path & "\Charlotte_isitelImmobProspection" & Val(Mid(ThisWorkbook.Name, 33)) - 3 & ".xlsm"
(Le chiffre 33 correspondant au nombre de caractères du nom du classeur.)

Mais avec le nouveau code plus complexe, je ne sais pas où modifier en fonction de la longueur du nom du classeur.
J'ai fait des tentatives mais je n'ai pas trouvé les correspondances
Si tu as un peu de temps, voudrais-tu me dire quels sont dans les codes les chiffres qu'il faut adapter ?
Un grand MERCI une fois de plus.

Bonne journée à toutes et à tous
Lionel,

 

[job75]

Bonjour Lionel,

Fichier joint avec la macro complétée :

Sub Enregistrer()
Dim chemin$, x$, fichier$, a(), n&
chemin = ThisWorkbook.Path & "\"
x = Environ("Username") & "_isitelImmobProspection "
ThisWorkbook.SaveAs chemin & x & Format(Now, "dd-mm-yy hh-mm-ss")
On Error Resume Next
Application.OnTime t, "Enregistrer", , False
t = Now + 5 / 1440 'délai de 5 minutes
Application.OnTime t, "Enregistrer"
fichier = Dir(chemin & x & "*.xlsm")
While fichier <> ""
    ReDim Preserve a(n) 'base 0
    a(n) = CDate(Mid(fichier, Len(x) + 1, 8) & Replace(Mid(fichier, Len(x) + 9, 9), "-", ":"))
    If a(n) <> "" Then n = n + 1
    fichier = Dir
Wend
tri a, 0, UBound(a)
'---on ne garde que les 2 derniers fichiers---
For n = 0 To UBound(a) - 2
    Kill chemin & x & Format(a(n), "dd-mm-yy hh-mm-ss") & ".xlsm"
Next
End Sub

Les fichiers supprimés sont ceux dont le nom commence par le nom de l'utilisateur Environ("Username").

A+

 

[Usine à gaz]

Vraiment encore Merci Gérard
je regarde et je te dis,
lionel,

 

[Usine à gaz]

Bonjour Gérard, Laurent950, Calvus, le forum,
@job75 Gérard
Dernier post LOL

Gérard, quand je dis qu'excel et la programmation sont magiques .... ça l'est pour moi

Je n'y comprends rien et je suis au bord de l'explosion neuronale (s'il m'en reste )

Ton dernier code est génial à bien des égards.

En revanche, en incluant pour le nom du classeur "Environ("Username") &" il renomme avec le nom de l'ordi.
ça marche pour moi car mon ordi porte mon prénom.

Il n'en est pas de même pour mes Commerciales qui, de plus ne sont pas des habituées de la manipulation informatique et il me parait difficile de leur faire changer si besoin le nom de leurs ordis.

Mais j'ai besoin vraiment que leur prénom apparaisse dans le nom du classeur, comme ceci par exemple :
Charlotte_isitelImmobProspection 16-07-19 12-49-49

J'ai modifié ton code : "x = Environ("Username") & "_isitelImmobProspection " ... comme ceci : "x = "Charlotte_isitelImmobProspection "

J'ai testé et ... miracle ou magie Gérardienne, ça marche nickel
et il ne garde bien que les 2 derniers classeurs sauvegardés.

Je me demande bien, si sachant que j'allais bidouiller, tu n'as pas codé en prévision de mon bidouillage.

En tout cas, ça marche et ça me donne bien le nom de classeur que je souhaite obtenir en ne gardant que les 2 derniers classeurs enregistrés.

Super merci même si je ne comprends pas tout LOL
lionel,

 

[Usine à gaz]

Bonjour à toutes et à tous,
Bonjour Gérard,

Me re-voilou (je croyais en avoir terminé avec ce fil) ... comme koi LOL

J'ai réussi après bien des tâtonnements à modifier ton code pour que les sauvegardes soient faite chaque X minutes.
et ça fonctionne super bien ... voilà déjà un bon moment que je le teste

Le fichier test que je mets en pièce jointe :
- sauvegarde chaque minute (pour le test) et ce sera chaque 5 minutes en exploitation,
- garde bien uniquement les 2 derniers fichiers sauvegardés.
et ça c'est nickel

Mais voilà LOL ou pas LOL :
je copie intègralement (à l'identique) les codes dans mon fichier de travail :
- codes module et dans le ThisWorkbook
- le fichier est bien sauvegardé sous le nouveau nom chaque minutes,
- Mais il garde tous les fichiers sauvegardés chaque minute

en fait c'est cette instruction "tri a, 0, UBound(a)" qui renvoie au code "Sub tri(a, gauc, droi)" qui ne s'exécute pas !
de ce fait, le code ci-dessous n'est pas pris en compte.
'---on ne garde que les 2 derniers fichiers---
For n = 0 To UBound(a) - 2
Kill chemin & x & Format(a(n), "dd-mm-yy hh-mm") & ".xlsm"
Next

Alors que le fichier test - codes identiques - fonctionne très bien.
J'ai fait bcp d'essais, également en pas à pas et chaque fois c'est pareil dans mon fichier de travail.
J'ai pensé que peut-être d'autres codes du fichier pourraient perturber l'exécution de ton code.
J'ai donc mis des Application.EnableEvents = False et True ... mais rien n'y fait.

Malheureusement, trop gros et confidentiel, je ne peux pas le joindre.
Pourtant, les codes sont identiques ... n'ai-je pas vu "un truc" ?

Bon WE
lionel,

 

[job75]

Bonjour Lionel,

J'ai failli ne pas répondre car ça devient pénible de te voir bricoler mes codes puis de venir quémander de l'aide.

Mais bon dans le fichier joint j'ai tout simplement remis la macro du post #25.

Si j'enregistre les secondes c'est parce qu'il y a une bonne raison de le faire !!!

A+

 

[Staple1600]

Bonjour le fil, arthour973, job75

arthour973
Le préfixe de la discussion indiquant XL 2016
Pourquoi se compliquer la vie alors Excel fait déjà cela tout seul (je parle du versionning)?

Récupérer une version antérieure d’un fichier Office - Support Microsoft

Si l’option Récupération automatique est activée, vous pouvez enregistrer automatiquement des versions de votre fichier pendant que vous travaillez dessus.

support.office.com