Time-out sur Application

Version imprimable

Voir 40 message(s) de cette discussion en une page

28/11/2008, 10h47
babybell

Time-out sur Application

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.
28/11/2008, 11h01
ucfoutu

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...;))..
28/11/2008, 12h13
babybell

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.
28/11/2008, 18h15
ucfoutu

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 ! ;)
28/11/2008, 21h22
babybell

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

Voilà donc :

Code:

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:

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 :lol:)
Voilà ...

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

cela se plante dans le code :

Code:

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"

28/11/2008, 22h08
ucfoutu
Pardi... :lol:
Mon copier-coller a sauté ces deux lignes essentielles, à placer tout en haut de ton code
Code:

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:

Private Sub Form_Initialize()

par

Code:

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)...
28/11/2008, 22h31
babybell

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.
28/11/2008, 22h34
ucfoutu

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 :

Citation:

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

Tu "relances" comment, exactement ?
28/11/2008, 22h43
JackOuYA

Bonsoir ,

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

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

Code:

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

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:

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:

UserFormxxx.Show

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

28/11/2008, 22h56
babybell

merci encore, je ne t'embête plus

Bonsoir

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:

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 ...?

Bonjour

J'ai réussi avec le code

Code:

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.

11/12/2008, 22h08
JackOuYA
bonsoir,

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

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 .
12/12/2008, 06h20
babybell

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 ?
12/12/2008, 11h28
JackOuYA

Bonjour,

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

Code:

ThisWorkBook.close true

est suffisant, le true c'est pour fermer en sauvant .. si tu ne dois pas enregistrer met false.
12/12/2008, 11h52
babybell

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)

Voir 40 message(s) de cette discussion en une page