Sauvegarder/Quitter quand inactif

Bonjour,

J'ai créé un fichier qui est utilisé régulièrement par plusieurs personnes.

J'ai donc ajouté un code, trouvé sur le net (voir plus bas), qui sauvegarde et ferme le fichier au bout de 5 minutes si le PC n'est pas utilisé (détection de mouvement de souris et de clavier).

Le problème, c'est que les utilisateurs laissent souvent le fichier excel ouvert, en arrière plan, pendant qu'ils travaillent sur un autre logiciel. Et donc, le décompte de 5 minutes ne démarre pas.

Je me demande s'il y a une façon de modifier ce code de manière à ce que le décompte démarre dès que le PC n'est pas utilisé OU que l'application n'est plus en "focus".

Une idée ?

Merci,

PS: je suis plutôt pas terrible en VBA. Je me contente de modifier les codes que je trouve.

Private Declare Function GetLastInputInfo Lib "user32.dll" (ByRef plii As LASTINPUTINFO) As Long
Private Type LASTINPUTINFO
 cbSize As Long
 dwTime As Long
End Type
Public Cycle_Ctrl, TimeOut, TesT, Ttr

Private Sub Test_Util()                 'Teste la présence d'un utilisateur
On Error Resume Next
TesT = 1                                'le Timer est On
Sheets(2).Range("U6").FormulaR1C1 = "Start"
Dim yaLastInput As LASTINPUTINFO        'c'est la variable qui detecte l'activité Clavier & Souris
Static yaMemoLastInput As Long
  yaLastInput.cbSize = Len(yaLastInput)
 If GetLastInputInfo(yaLastInput) <> 0 Then
    If yaMemoLastInput <> yaLastInput.dwTime Then
        yaMemoLastInput = yaLastInput.dwTime 'Memorise "le moment" de la derniére activité.
        YaQuelcun 'Le moment de la derniére activité à évolué on continue.
     End If
 End If
 Cycle_Ctrl = Now + TimeSerial(0, 0, Ttr) 'Cycle de Contrôle d'activité toutes les "Ttr"s
 Cpt_Off
 Application.OnTime Cycle_Ctrl, "Test_Util" 'Relance le Test
End Sub

Private Sub YaPerson()                  'Au bout de 5mn on ferme l'appli. ("Eject")
    On Error Resume Next
    Application.OnTime Cycle_Ctrl, "Test_Util", , False 'Intercepte le dernier Cycle de Contrôle
    TesT = 0                            'Le Timer est Off
    Sheets(2).Range("U6").FormulaR1C1 = "Stop"
    UserForm1.Hide
'    ZoZo = MsgBox("That's all folks !!!", vbExclamation, "TIMEOUT")
    Application.OnTime Now + TimeSerial(0, 0, 1), "Eject" 'lance la fermeture du fichier dans 1s le temps d'intercepter le timer
End Sub

Private Sub YaQuelcun()             ' On détecte l'utilisateur, on continue
     Static yaLastDate As Date      'Variable statique permettant d'effacer la tache planifiée..
     If yaLastDate <> 0 Then
       ' Efface la date planifiée ..
       On Error Resume Next
        Application.OnTime yaLastDate, "YaPerson", , False 'intercepte YaPerson et relance le timer
        UserForm1.Hide          ' le timeout est relancé, on cache le Userform
        Ttr = 5                 ' Le cycle de scrutation repasse à 5s.
     End If
'Calcule la prochaine échéance dans 5mn(+1s pour lancer "Eject")
      yaLastDate = Now + TimeSerial(0, 5, 0)
      TimeOut = yaLastDate         ' Mémorisation de la valeur du TimeOut.
      Application.OnTime yaLastDate, "YaPerson" 'Appel procédure fermeture de l'application
    End Sub

Private Sub Stop_Timer()                'Commande cachée pour arrêter TimeOut proprement.
On Error Resume Next
    Application.OnTime Cycle_Ctrl, "Test_Util", , False 'Intercepte le dernier Cycle de Contrôle
    Application.OnTime TimeOut, "YaPerson", , False ' Intercepte le TimeOut
    TesT = 0                            'le est Timer OFF
    Sheets(2).Range("U6").FormulaR1C1 = "Stop"
    UserForm1.Hide
    ZoZo = MsgBox("Arrêt du Timer", vbInformation, "TIME OUT STOP !!!") '(message Info)
End Sub

Private Sub End_Timer()             'A lancer dans "BeforeClose" pour arrêter le Timer
On Error Resume Next                ' lors de la fermeture volontaire du fichier.
    Application.OnTime Cycle_Ctrl, "Test_Util", , False 'Intercepte le dernier Cycle de Contrôle
    Application.OnTime TimeOut, "YaPerson", , False ' Intercepte le TimeOut
    TesT = 0                        'le est Timer OFF
    UserForm1.Hide
End Sub

Private Sub Start_Timer()           'Commande de demarrage du TimeOut - A lancer dand Workbook_Open.
    Ttr = 5                         ' C'est le cycle de scrutation du Timer : 5s
    Test_Util                       ' Lance le bazard.
End Sub

Private Sub Eject()
' Procédure de sortie de l'application (proprement avec sauvegarde !!)
On Error Resume Next
Dim i, xx2, xx3
    End_Timer
    UserForm1.Hide
' Ferme toutes les feuilles ouvertes , puis ferme l'application.
    xx2 = Workbooks.Count
    xx3 = xc + 1
    For i = xx2 To xx3 Step -1
    Workbooks(i).Activate
' Teste si le fichier courant est en Lecture Seule
    If Right(Application.Caption, 15) = "[Lecture seule]" Then GoTo 100 Else
    ActiveWorkbook.Save
100 '
    ActiveWorkbook.Saved = True
    ActiveWorkbook.Close
    Next
' Teste si le Workbook est en Lecture Seule
If Right(Application.Caption, 15) = "[Lecture seule]" Then GoTo 200 Else
ActiveWorkbook.Save
200 '
ActiveWorkbook.Saved = True
ActiveWorkbook.Close
End Sub

Private Function Cpt_Off()      ' C'est la fonction qui gère l'affichage du compte à rebour.
Dim aaa, ZaZa
aaa = TimeOut - Now
ZaZa = Format(aaa, "long time")
Sheets(2).Range("V6").FormulaR1C1 = Ttr
Sheets(2).Range("W6").FormulaR1C1 = Format(TimeOut, "long time")
Sheets(2).Range("X6").FormulaR1C1 = ZaZa
    If UserForm1.Visible = True Then GoTo 50 Else ' L'affichage du Userform n'est demandé qu'une seule fois.
    If ZaZa < "00:00:28" Then UserForm1.Show Else ' affiche le temps restant dans le Userform.
50  ' L'affichage du Userform passe le cycle de scutation à 1s. (compte à rebour)
UserForm1.Label3.Caption = Right(ZaZa, 2)
End Function

Personne n'a de solution à mon problème ?

Bonjour,

J'ai développé récemment un programme dont la demande ressemble beaucoup à la vôtre.

Je le mets en pièce jointe si cela peut vous aider.

Cordialement.

PMO

Patrick Morange