• Initiateur de la discussion Initiateur de la discussion Armarm
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Armarm

XLDnaute Nouveau
Bonjour ,

J'ai installée un code VBA sur un fichier partagée afin que le fichier se referme automatiquement après 10 minutes d'inactivité. Mais le fichier beug, il s'ouvre et se referme à chaque fois, je pense que c'est un probléme au niveau du réglage sur le temps de ces 2 lignes :

Reste = Reste - TimeValue("00:10:00")
temps = Now + TimeValue("00:10:00")

CODE: TOUT SÉLECTIONNER
Public HeureArrt
Public DŽlai
Public Reste
Public temps
Sub ProchainArret()
HeureArrt = Now + DŽlai
Reste = DŽlai
End Sub
Sub Fin()
On Error Resume Next
Application.OnTime temps, Procedure:="majHeure", Schedule:=False
Application.OnTime HeureArrtt, Procedure:="Fin", Schedule:=False 'annule ŽvŽnnemennt
ThisWorkbook.Close True
End Sub

Sub majHeure()
On Error Resume Next
Sheets(1).[A1] = Reste
Reste = Reste - TimeValue("00:10:00")
temps = Now + TimeValue("00:10:00")
Application.OnTime temps, "majHeure"
End Sub



CODE: TOUT SÉLECTIONNER
Private Sub Workbook_Open()
DŽlai = TimeValue("00:10:00")
Reste = DŽlai
ProchainArret
majHeure
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As range)
On Error Resume Next
Application.OnTime HeureArrt, Procedure:="Fin", Schedule:=False
ProchainArret
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ThisWorkbook.Save
On Error Resume Next
Application.OnTime HeureArrt, Procedure:="Fin", Schedule:=False ' annule ŽvŽnnement
Application.OnTime temps, Procedure:="majHeure", Schedule:=False
End Sub
 
Bonjour.
Comprends pas trop ce que vous voulez faire.
Si vous voulez que ça se ferme au bout de 10 minutes, reconduites à chaque SheetSelectionChange, ça devrait être plus simple que ça.
Si vous voulez en même temps que le délai restant soit affiché dans une cellule, il me semble qu'il faut prévoir pour cela une fréquence plus grande, or je ne vois que des TimeValue("00:10:00") dans votre code.
 
Bonjour à tous,

Ceci fonctionne chez moi ( réglage : 2 minutes d'inactivité) :
Dans un module:
VB:
Public HeureArrêt
Sub ProchainArret()
HeureArrêt = Now + TimeValue("00:02:00")
Application.OnTime HeureArrêt, "Fin"
Sheets(1).[A1]=HeureArrêt
End Sub

Sub Fin()
  On Error Resume Next
  Application.OnTime HeureArrêt, Procedure:="Fin", Schedule:=False    'annule événnement
  ThisWorkbook.Close True
End Sub

Dans ThisWorkBook:
VB:
Private Sub Workbook_Open()
ProchainArret
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
Application.OnTime HeureArrêt, Procedure:="Fin", Schedule:=False
ProchainArret
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  ThisWorkbook.Save
  'ThisWorkbook.Saved = True
  On Error Resume Next
  Application.OnTime HeureArrêt, Procedure:="Fin", Schedule:=False  ' annule événnement
End Sub

A+ à tous
 
Pour un affichage du nombre de minutes restantes, essayez comme ça :
Module standard :
VB:
Option Explicit
Private HeureOnTime As Date
Public Sub Relancer10min()
StopperOnTime
Worksheets(1).[A1].Value = 10
Planifier1min
End Sub
Private Sub Planifier1min()
HeureOnTime = Now + TimeSerial(0, 1, 0)
Application.OnTime HeureOnTime, "MàJHeure"
End Sub
Public Sub MàJHeure()
Dim MInR As Long
MInR = Worksheets(1).[A1].Value - 1
If MInR > 0 Then
   Worksheets(1).[A1].Value = MInR
   Planifier1min
Else
   HeureOnTime = 0
   ThisWorkbook.Close True: End If
End Sub
Public Sub StopperOnTime()
If HeureOnTime = 0 Then Exit Sub
Application.OnTime HeureOnTime, "MàJHeure", Schedule:=False
HeureOnTime = 0
End Sub
Dans la Workbook_Open et les Worksheet_Selection change :
VB:
 Relancer10min
Dans la Workbook_BeforeClose :
VB:
StopperOnTime
 
Merci pour vos réponses, non je ne veut pas que le nombre de minutes soit afficher.
Je veut juste que le fichier se ferme et se sauvegarde automatiquement après 10 minutes d'inactivité.
J'ai aussi un bouton macro qui permet de sauvegarder et quitter pensez vous que le beug est due à cela ?
 
Pourtant je ne les ai pas inventées votre procédure MàJHeure et votre instruction Sheets(1).[A1] = Reste
J'ignore à quoi votre bogue était dû. Trop illisible tout ça. Essayez simplement comme ça :
VB:
Option Explicit
Private HeureOnTime As Date
Public Sub ReLancer10min()
StopperOnTime
HeureOnTime = Now + TimeSerial(0, 10, 0)
Application.OnTime HeureOnTime, "FermerClasseur"
End Sub
Public Sub FermerClasseur()
HeureOnTime = 0
ThisWorkbook.Close True
End Sub
Public Sub StopperOnTime()
If HeureOnTime = 0 Then Exit Sub
Application.OnTime HeureOnTime, "FermerClasseur", Schedule:=False
HeureOnTime = 0
End Sub
Mêmes dispositions que dans ma proposition précédente pour les autres modules.
 
Pourtant je ne les ai pas inventées votre procédure MàJHeure et votre instruction Sheets(1).[A1] = Reste
J'ignore à quoi votre bogue était dû. Trop illisible tout ça. Essayez simplement comme ça :
VB:
Option Explicit
Private HeureOnTime As Date
Public Sub ReLancer10min()
StopperOnTime
HeureOnTime = Now + TimeSerial(0, 10, 0)
Application.OnTime HeureOnTime, "FermerClasseur"
End Sub
Public Sub FermerClasseur()
HeureOnTime = 0
ThisWorkbook.Close True
End Sub
Public Sub StopperOnTime()
If HeureOnTime = 0 Then Exit Sub
Application.OnTime HeureOnTime, "FermerClasseur", Schedule:=False
HeureOnTime = 0
End Sub
Mêmes dispositions que dans ma proposition précédente pour les autres modules.

Je comprend mieux !!! Mon code "MajHeure" était pour afficher les minutes restante dans une cellule ?
J'ai un peu de mal avec ce code veuillez m'excuser.
 
Merci beaucoup !! Et effectivement non je ne voulais pas du tout afficher le temps restant donc ce code était inutile. Je vais essayer votre code pour voir si mon fichier se ferme bien au bout de 10 minutes sans se réouvrir par derriére .
 
😀😀Merci beaucoup, grâce à votre aide j'ai enfin réussis à installer un timer sans aucun beug rien .

Mais j'ai une derniére question , connaissez vous un code à ajouter au code que vous m'avez fournis qui permet de sauvegarder et quitter au bout de 10 minute d'inactivité mais lorsequ'on réouvre le fichier j'aimerais qu'il s'ouvre sur une page spécifique ?

Merci
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
9
Affichages
141
  • Question Question
Microsoft 365 Problème de date
Réponses
5
Affichages
162
  • Question Question
Microsoft 365 Erreur UBound
Réponses
4
Affichages
144
  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
169
Retour