Microsoft 365 Enregistrement automatique et sans confirmation

[Dravol]

Bonjour à tous,

J'ai besoin de votre aide pour compléter ce code (en même temps si je n'avais pas besoin d'aide, ce post n'existerai pas) ^^

J'ai 2 requêtes :
1- Enregistrer automatiquement toutes les 5 minutes par exemple
2- Forcer l'enregistrement sans me demander une confirmation après le 2ieme enregistrement automatique (vous savez la petite phrase "un fichier nommé 'xxxxx.xls' existe déjà à cet emplacement. Voulez-vous le remplacer ?)

Sub Enregistre()
ActiveWorkbook.SaveAs Filename:= _
"chemin d'accès de mon fichier" & Range("L5") & " - " & Range("L2") & ".xls"
End Sub

Merci d'avance pour vos réponses.

Juste pour vous expliquer pourquoi cette demande. Il s'agit d'un fichier de ctrl qualité qui ne doit pas écraser le fichier vierge (d'origine) et s'enregistrer ailleurs comme vous pouvez le voir dans mon code. Etant donné que je veux supprimer le format papier (un peu d'écologie ne fait pas de mal), j'ai besoin qu'une sauvegarde se fasse régulièrement afin de ne pas perdre les données en cas de coupure de courant par exemple.

Drav.

 

[Bernard_XLD]

Bonjour Dravol, le forum

Vite fait !

Cordialement, @+

Sub Enregistre()
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= _
"chemin d'accès de mon fichier" & Range("L5") & " - " & Range("L2") & ".xls"
Application.DisplayAlerts = True
End Sub

 

[Dravol]

Bonjour Dravol, le forum

Vite fait !

Cordialement, @+

Sub Enregistre()
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= _
"chemin d'accès de mon fichier" & Range("L5") & " - " & Range("L2") & ".xls"
Application.DisplayAlerts = True
End Sub

Bonjour Yeahou

Merci pour ce retour, je teste ça demain (mais ça me paraît répondre parfaitement au point 2).

Si vous avez des idées pour compléter ce code pour le point 1 je suis preneur.

Bonne soirée.

Drav.

 

[Bernard_XLD]

Re,

Utilisez dans le module Thisworkbook

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.OnTime EarliestTime:=Time_Enr, Procedure:="Enregistre", Schedule:=False
End Sub
Private Sub Workbook_Open()
Time_Enr = Now + TimeValue("00:05:00")
Application.OnTime Time_Enr, "Enregistre"
End Sub

dans un module standard, votre proc modifiée comme cela

Public Time_Enr#
Sub Enregistre()
Time_Enr = Now + TimeValue("00:05:00")
Application.OnTime Time_Enr, "Enregistre"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= _
"chemin d'accès de mon fichier" & Range("L5") & " - " & Range("L2") & ".xls"
Application.DisplayAlerts = True
End Sub

Cordialement, @+

 

[Dravol]

Bonjour Yeahou

L'enregistrement auto ne se fait pas avec dans le module standard.
J'ai un message d'erreur :

Code module 1 :
Public Time_Enr As Double
Sub Enregistre()
Time_Enr = Now + TimeValue("00:01:00")
Application.OnTime Time_Enr, "Enregistre"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= _
"W:\EUFR\POUZ\$DATA\GRP-QUALITE\Q Produit\#Fiche de contrôle Interne\" & Range("L5") & " - " & Range("L2") & ".xls"
Application.DisplayAlerts = True
End Sub

Code Thisworkbook :
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If ThisWorkbook.Sheets("Contrôle Qualité").Range("L5") = "" Then
Cancel = True
MsgBox "Mettre le N° de commande avant de quitter"
End If
' avant la fermeture
Call Enregistre
End Sub

as-tu une idée ?
Drav.​

 

[Dravol]

Bonjour Yeahou

L'enregistrement auto ne se fait pas avec dans le module standard.
J'ai un message d'erreur :

Regarde la pièce jointe 1127194​

Regarde la pièce jointe 1127195​

​

Code module 1 :​

Public Time_Enr As Double​

Sub Enregistre()​

Time_Enr = Now + TimeValue("00:01:00")​

Application.OnTime Time_Enr, "Enregistre"​

Application.DisplayAlerts = False​

ActiveWorkbook.SaveAs Filename:= _​

"W:\EUFR\POUZ\$DATA\GRP-QUALITE\Q Produit\#Fiche de contrôle Interne\" & Range("L5") & " - " & Range("L2") & ".xls"​

Application.DisplayAlerts = True​

End Sub​

​

Code Thisworkbook :​

Option Explicit​

Private Sub Workbook_BeforeClose(Cancel As Boolean)​

If ThisWorkbook.Sheets("Contrôle Qualité").Range("L5") = "" Then​

Cancel = True​

MsgBox "Mettre le N° de commande avant de quitter"​

End If​

' avant la fermeture​

Call Enregistre​

End Sub​

​

as-tu une idée ?​

Drav.​

J'ai essayé de l'enregistrer une première fois et ensuite ça fonctionne (en gros il faut un premier enregistrement manuel pour que le code fonctionne et qu'il reconnaisse l'existence du fichier).

Si je ne fais pas un premier enregistrement, j'ai ce message d'erreur.

Drav.

 

[Bernard_XLD]

Bonjour

tout dépend de ce que vous mettez dans le chemin et il faut cibler précisément vos cellules contenant le nom du fichier avec le nom de la feuille dans laquelle elles sont.
voici un exemple fonctionnel créant une copie de sauvegarde, toutes les cinq secondes, nommée essai.xlsm à l'emplacement du fichier source

sinon, postez un fichier exemple, light et anonymisé, pour avoir une solution adaptée

Bien cordialement, @+

 

[Dravol]

Autre problème, le fichier s'ouvre tout seul chaque minute (tempo d'enregistrement)

Drav.

 

[Dravol]

ok, je vais joindre ça.

 

[Bernard_XLD]

Autre problème, le fichier s'ouvre tout seul chaque minute (tempo d'enregistrement)

il ne faut pas oublier ces lignes pour arréter l'enregistrement auto, sinon le fichier se réouvre pour exécuter la macro

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.OnTime EarliestTime:=Time_Enr, Procedure:="Enregistre", Schedule:=False
End Sub
Private