Time-out sur Application

**babybell** · 28/11/2008, 10h47

Bonjour amis développeurs.

Existe-t-il une fonction pour qu'en cas ne non utilisation d'une application Excel, il y ait un time-out qui ferme le programme.

En effet, ayant une appli qui sert à beaucoup de monde, et ne pouvant la faire utiliser par plusieurs personnes en même temps (par obligation), lorsqu'un utilisateur oubli de la fermer avant de partir, les autres sont obligés d'attendre son retour, car son poste se vérouille.

Merci à vous de me renseigner sur la faisabilité de ma demande.

**ucfoutu** · 28/11/2008, 11h01

Bonjour,

C'est en effet possible, oui.
Mais il te faudra utiliser la fonction GetLastInputInfo de la librairie User32 de l'Api de Windows et un "timer" (que tu peux mettre en oeuvre soit avec une autre fonction de l'API de Windows, soit en jouant habilement avec Application.Ontime).
La chose est donc réalisable, mais assez coûteuse en ressources...
Ne serait-ce pas préférable de te servir des outils de Windows pour mettre en veille/mot-de-passe ?

EDIT IMPORTANT :
Ce que j'ai dit plus haut repèrera une inactivité TOTALE de l'utilisateur (que ce soit donc sur ta fenêtre ou ailleurs)
Si tu veux, par contre, imposer cette limitation de durée d'inactivité à ta seule appli, le principe est le même que précédemment, sauf à remplacer la fonction GetLastInputInfo (qui va repérer toutes les activités éventuelles de l'utilisateur) par la fonction GetInputState (qui, elle, ne repèrera que les messages système reçus par ta seule fenêtre .... Par le seul "fil" appelant, pour être plus précis...

)..

**babybell** · 28/11/2008, 12h13

Merci de ta réponse, mais n'étant pas assez féru en VBA, je ne vois pas quelle est ou sont les instructions et la manière de s'en servir. Je ne vois pas quel est le code.

**ucfoutu** · 28/11/2008, 18h15

Je veux bien m'y mettre...

Mais tu n'as pas choisi !
Que veux-tu ?
Une fin de ton appli si plus personne ne touche quoi que ce soit sur le PC pendant une durée déterminée ? (c'est la plus logique en matière de sécurité de ton appli)
Je ne vais tout de même pas écrire les codes correspondant aux deux choix possibles !

**babybell** · 28/11/2008, 21h22

C'est tout à fait ce que j'aimerais. Je te remercie encore pour ton aide.

**ucfoutu** · 28/11/2008, 21h48

Voilà donc :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Private Type LASTINPUTINFO
    cbSize As Long
    dwTime As Long
End Type
Private quand As Double, interval As Integer, duree As Long
 
Private Sub Form_Initialize()
  Dim monintervalle As Integer
  monintervalle = 3 ' pour un intervalle de 3 secondes entre chaque vérif du timer
  duree = 100 ' on définit ici la durée (en secondes) d'inactivité au delà le laquelle on intervient
  TimerOn monintervalle
End Sub
 
Public Function inactif(ByVal duree As Long) As Boolean
    Dim deract As LASTINPUTINFO
    deract.cbSize = Len(deract)
    If GetLastInputInfo(deract) <> 0 Then
        inactif = (GetTickCount - deract.dwTime) > (1000 * duree)
    End If
End Function
 
 
 
'=====================================================================================
'je n'ai pas Excel sous la main pour pouvoir vérifier ce qui suit (substitut d'un Timer)
' j'écris donc à main levée
' corrige au besoin (devrait pas y avoir beaucoup à corriger)
Sub TimerOn(intv As Integer)
   interval = intv
   Application.OnTime Now + TimeSerial(0, 0, interval), "LeTimer"
End Sub
 
Sub TimerOff()
   On Error Resume Next
   Application.OnTime quand, "LeTimer", , False
End Sub
 
Sub LeTimer()
   If inactif(duree) Then
     TimerOff
     MsgBox "durée d'inactivité dépassée"
     ' remplace ici le msgbox par tes instructions à toi (de fermeture, donc)
     Exit Sub
   End If
   Lheure = Now + TimeSerial(0, 0, interval)
   Application.OnTime quand, "LeTimer"
End Sub

Je garantis jusqu'au trait ... Vérifie le reste (je n'ai pas Excel pour le tester, bien que celà devrait être bon).
J'ai réglé à 100 secondes de durée d'inactivité ici :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

duree = 100

Pour tes tests divers, choisis de remplacer 100 par beaucoup moins (à moins que tu ne préfères boire un café entre chaque essai

)
Voilà ...

Edit : Ah oui : pour tes essais, simule une véritable inactivité, hein .... tu ne touches plus rien (ni souris, ni clavier).

**babybell** · 28/11/2008, 21h59

cela se plante dans le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Public Function inactif(ByVal duree As Long) As Boolean
    Dim deract As LASTINPUTINFO
    deract.cbSize = Len(deract)
    If GetLastInputInfo(deract) <> 0 Then
        inactif = (GetTickCount - deract.dwTime) > (1000 * duree)
    End If
End Function

Sub ou fonction non définie à "GetLastInputInfo"

**ucfoutu** · 28/11/2008, 22h08

Pardi...

Mon copier-coller a sauté ces deux lignes essentielles, à placer tout en haut de ton code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Private Declare Function GetLastInputInfo Lib "user32.dll" (ByRef plii As LASTINPUTINFO) As Long
Private Declare Function GetTickCount Lib "kernel32.dll" () As Long

J'en profite :
Change

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Private Sub Form_Initialize()

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Private Sub UserForm_Initialize()

Car tu es sous VBA/Excel

Bien évidemment, si tu n'utilises pas d'userForm mais directement ta feuille, utilise un autre évènement (Celui de l'ouverture de ton classeur, par exemple)...

**babybell** · 28/11/2008, 22h31

Je suis désolé, mais je ne dois pas faire ce qu'il faut. Effectivement, quand je lance le code, soit manuellement, soit en ouverture, cela déclenche tout de suite le msgbox. Puis quand je relance, il ne se passe plus rien.

**ucfoutu** · 28/11/2008, 22h34

Je ne sais que te répondre ...

1) Où as-tu mis ce code : dans un UserForm ou ailleurs ?
2) montre ton code (fais un petit project avec uniquement celà).

EDIT :

Autre chose :
qu'entends-tu exactement par :

Puis quand je relance, il ne se passe plus rien.

Tu "relances" comment, exactement ?

**JackOuYA** · 28/11/2008, 22h43

Bonsoir ,

babybell , ton applicaiton est composée comment .? l'utilisateur agit sur des feuilles de calculs ? est - til bloqué sur un userform ..?

**babybell** · 28/11/2008, 22h45

j'ai laissé tous le code dans un module et j'ai mis

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Private Sub Workbook_Open()
   If inactif(duree) Then
     TimerOff
     MsgBox "durée d'inactivité dépassée"
     ' remplace ici le msgbox par tes instructions à toi (de fermeture, donc)
     Exit Sub
   End If
   Lheure = Now + TimeSerial(0, 0, interval)
   Application.OnTime quand, "LeTimer"
End Sub

en ouverture

Tu dois trouver que je dois vraiment faire des progrès et tu as raison. Je te remercie encore

**ucfoutu** · 28/11/2008, 22h47

Mais... !!!

Tu ne peux écrire ainsi !!!
Et relis ma signature : je n'ouvre pas les pièces jointes ..

Bon....

Ne te casse plus la tête :
Fais EXACTEMENT CECI :
Crée un UserForm à part et colle-lui la TOTALITE du code que je t'ai donné...
Ce userform ne sera pas visible... mais le code tournera...

Seule chose à modifier (pour qu'il ne soit pas visible) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Private Sub UserForm_Initialize()
  Dim monintervalle As Integer
  monintervalle = 3 ' pour un intervalle de 3 secondes entre chaque vérif du timer
  duree = 10 ' on définit ici la durée (en secondes) d'inactivité au delà le laquelle on intervient
  TimerOn monintervalle
  Me.Hide
End Sub

Et dans ton ouverture de classeur :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

UserFormxxx.Show

ou UserFormxxx est le nom donné au dit UserForm.
Bonne nuit

**babybell** · 28/11/2008, 22h56

merci encore, je ne t'embête plus

Bonsoir

**JackOuYA** · 28/11/2008, 23h14

Vu que tu ne m'as pas répondu.. j'oubli l'histoire de l'userform,

voila un code à placer dans un module (tous le code) seule la procédure yaTestActivite est à appellé dans thisWorbook_open...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Private Declare Function GetLastInputInfo Lib "user32.dll" (ByRef plii As LASTINPUTINFO) As Long
Private Type LASTINPUTINFO
 cbSize As Long
 dwTime As Long
End Type
'
' Procedure yaTestActivité .., à appeller au sur
'avec ThisWorkBook_open, ensuite elle s'appelle" toutes les secondes pour controler l'activité
Sub yaTestActivite()
 Dim yaLastInput As LASTINPUTINFO
 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é.
        yaContinue 'Le moment de la derniére activité à évoluer on continue.
     End If
 End If
 Application.OnTime Now + TimeSerial(0, 0, 1), "yaTestActivite" 'Test activité toutes les 10s
End Sub
Sub yaStoppe()
    MsgBox "Fin"
End Sub
'
' yaContinue doit être appellé au moins toutes les 30s sinon
' elle appelle la procédure yaStoppe..
'
'
    Sub yaContinue()
     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 EarliestTime:=yaLastDate, _
        Procedure:="yaStoppe", Schedule:=False
     End If
      'Calcul prochaine date dans 30s
      yaLastDate = Now + TimeSerial(0, 0, 30)
      Application.OnTime yaLastDate, "yaStoppe" 'Appel procédure fin application
 
    End Sub

tu dis quoi ...?

**babybell** · 11/12/2008, 14h21

Bonjour

J'ai réussi avec le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
Private Declare Function GetLastInputInfo Lib "user32.dll" (ByRef plii As LASTINPUTINFO) As Long
Private Type LASTINPUTINFO
 cbSize As Long
 dwTime As Long
End Type
'
' Procedure yaTestActivité .., à appeller au sur
'avec ThisWorkBook_open, ensuite elle s'appelle" toutes les secondes pour controler l'activité
Sub yaTestActivite()
 Dim yaLastInput As LASTINPUTINFO
 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é.
        yaContinue 'Le moment de la derniére activité à évoluer on continue.
     End If
 End If
 Application.OnTime Now + TimeSerial(0, 0, 1), "yaTestActivite" 'Test activité toutes les 10s
End Sub
Sub yaStoppe()
Application.DisplayAlerts = False
For Each classeur In Workbooks
If classeur.Name <> "Base des Incidents.xls" Then
Exit For
End If
GoTo Fin
Next classeur
Windows("Base des Incidents.xls").Activate
    Application.CommandBars("Formatting").Visible = True
    Application.CommandBars("Standard").Visible = True
    Application.DisplayFullScreen = False
ActiveWorkbook.Close
Fin:
    Application.CommandBars("Formatting").Visible = True
    Application.CommandBars("Standard").Visible = True
    Application.DisplayFullScreen = False
Application.Quit
 
   ' MsgBox "Fin"
End Sub
'
' yaContinue doit être appellé au moins toutes les 30s sinon
' elle appelle la procédure yaStoppe..
'
'
    Sub yaContinue()
     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 EarliestTime:=yaLastDate, _
        Procedure:="yaStoppe", Schedule:=False
     End If
      'Calcul prochaine date dans 5 minutes
      yaLastDate = Now + TimeSerial(0, 0, 300)
      Application.OnTime yaLastDate, "yaStoppe" 'Appel procédure fin application
 
    End Sub

à mettre un timing comme je voulais.
Malheureusement, maintenant, dans mon programme, lorsque je veux faire Close et non pas Quit, il me met le message " Impossible d'exécuter le code en mode arrêt".
Lorsque je fais "OK" et que je relance l'excécution manuellement, il me relance tout le programme.

Que faut-il faire pour en sortir ?

Merci de votre réponse.

**JackOuYA** · 11/12/2008, 22h08

bonsoir,

explique moi déjà ce que tu as voulu faire avec ce code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
For Each classeur In Workbooks
If classeur.Name <> "Base des Incidents.xls" Then
Exit For
End If
GoTo Fin
Next classeur
Windows("Base des Incidents.xls").Activate

ton code il est placé ou ? dans "Base des Incidents.xls" où un autre classeur .

**babybell** · 12/12/2008, 06h20

Bonjour

Effectivement, ce code est placé dans ma base des incidents. Comme je te l'ai expliqué, nous sommes plusieurs à nous en servir, et certains oublient de la quitter de temps en temps. Je ne veux pas la partager car lorsque l'on s'en sert, nous créons des fiches en incrémentant des numéros.
Comme nous avons plusieurs appli en même temps, mon code permet de ne pas toutes les fermer lors de la sortie de cette base, par un bouton qui m'envoie dans un module qui reprend le même code que celui-ci.
Mais ce qui se produit, à mon avis, c'est qu'avec le time out, lors de la sortie de la base, comme il y a déjà une macro résidente qui tourne, excel détecte une erreur et, je ne sais pourquoi, relance l'appli.
J'ai réussi à contourner ce problème en faisant directement quit pour sortir, mais là toutes les applis se ferment, ce que je ne veux pas.
Ais-je été assez clair ?

**JackOuYA** · 12/12/2008, 11h28

Bonjour,

Donc pour fermer le classeur contenant la macro pas besoin de boucle for ou autre .. :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ThisWorkBook.close true

est suffisant, le true c'est pour fermer en sauvant .. si tu ne dois pas enregistrer met false.

**babybell** · 12/12/2008, 11h52

J'ai du mal m'exprimer.
Mon problème est que, lorsque j'ai lancé le code du time out dans la base incidents, quand je veux sortir de cette base et que j'ai plusieurs classeurs ouverts, je ne le peux pas.
Le message d'erreur," Impossible d'exécuter le code en mode arrêt".
je le vois quand je veux sortir en mode pas à pas(F8)

Time-out sur Application

Macros et VBA Excel

Discussions similaires

Partager

Partager