Comment fermer un classeur Excel après 15 minutes d'inactivité?

Excel 2000
Comment fermer un classeur Excel après 15 minutes d'inactivité,
c'est -à-dire qu'aucun utilisateur a travaillé sur le classeur depuis 15 minutes
Merci
Christine

Classeur à télécharger de Paul V

FermAuto.zip 17 ko

Il y a quelques imperfections car je ne voulais pas y passer trop de temps.
- L'inactivite est considéré ici comme une absence de modification dans la
sélection alors qu'il faudrait aussi considérer le changement de feuille,
les scrolling et autres joyeuseté comme des activités qui devraient
suspendre la fermeture.
- Le délai est règlé sur 10 secondes de vérification + 10 secondes de tampon
pour permettre d'arrêter la fermeture. Idéalement, il faudrait passer par
une fenêtre de paramètrage qui permettrait de règler les dicvers paramètres
comme la durée. Si nécessaire.....
- Je l'ai créé comme modèle afin de faciliter le démarrage et il faudrait
prévoir de désactiver totalement les procédures si nécessaire.
- etc..

Bref pas mal d'autres améliorations possibles.
Paul V.

Macro de Starwing

Private Sub Worksheet_Change(ByVal Target As Range)
Application.OnTime Now + TimeValue
("00:00:15"), "FermerFichier" 'Se ferme en 15 secondes
End Sub

Sub FermerFichier()
ActiveWorkbook.Close
End Sub

Macro de Michdenis

Copier cette section dans le ThisWorkbook de ton projet :

Private Sub Workbook_Open()
HeureDepart = Format(Time, "HH:MM:SS")
Check
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
T = Time
End Sub

Dans un module standard, copie ce qui suit :

Public HeureDepart As Date
Public T As Date

Sub Check()
Application.OnTime Now + TimeValue("15:00:00"), "Delai"
End Sub

Sub Delai()
Dim HeureFin As Date, S As Integer
T = T - TimeValue("15:00:00")
If TimeValue(Format(T - HeureDepart, "HH:mm:ss")) _
>= TimeValue("14:59:58") Then
Fermeture
Else
HeureDepart = Format(Time, "HH:MM:SS")
Check
End If
End Sub

Sub Fermeture()
ThisWorkbook.Save
Application.Quit
End Sub

Un simple exemple de compte à rebours. Daniel.j

Ici 2 mn s'ecoulent

Sub CompteARebours()
[a1] = Now 'pour test
compteur = 1
For compteur = 1 To 0 Step -1
nouvHeure = Hour(Now())
nouvMinute = Minute(Now()) + 1
nouvSeconde = Second(Now())
reprise = TimeSerial(nouvHeure, nouvMinute, nouvSeconde)
Application.Wait reprise
Next
[a2] = reprise 'pour test
End Sub

[top]