application.ontime en mode edition de cellule

joebar2

XLDnaute Nouveau
Bonjour à tous,

J'utilise la commande application.ontime pour fermer automatiquement après 10mn d'inactivité un classeur partagé en réseau par plusieurs utilisateurs.

Jusque là, pas de problème...

Si un utilisateur saisie une valeur dans une cellule de ce classeur (ou d'un autre classeur d'ailleurs) sans valider par "entrée", Excel est alors en mode "busy" et la macro lancée par ontime ne s'exécutera que lorsque l'utilisateur validera sa saisie. Ce qui peut prendre un certain temps (plus de 10mn parfois) et ma fermeture automatique planifiée devient inopérante...
J'ai pensé à SendKeys "{ESC}" pour sortir de l'édition de la cellule mais je ne vois pas comment l'utiliser dans mon cas précis d'autant plus que le blocage peut venir de n'importe quel classeur ouvert.

Avez vous une solution à mon problème?
 

tototiti2008

XLDnaute Barbatruc
Re : application.ontime en mode edition de cellule

Bonjour joebar2,

Personnellement, je ne vois pas.
Plusieurs "phénomènes" peuvent empêcher un OnTime de s'exécuter à l'heure :
Edition d'une cellule, qui à priori empêchera tout code de se lancer (et donc aussi ton Sendkeys)
Débogage d'un autre code
Et surement d'autres que je n'ai pas rencontré...
 

PMO2

XLDnaute Accro
Re : application.ontime en mode edition de cellule

Bonjour,

Une démarche compliquée qui semble faire

ATTENTION faites l'essai sur une copie de votre classeur
D'autre part, ne laissez pas la fenêtre du VBE activée mais laissez les codes évènementiels lancer le code.

1) Copiez le code suivant dans la fenêtre de code de ThisWorkbook
Code:
Private Sub Workbook_Open()
Dim rep%
rep = MsgBox("Voulez-vous activer les évènements. Le classeur se fermera dans environ " & MILLI_SECONDES / 1000 & " secondes.", vbYesNo)
If rep% = vbNo Then
  Application.EnableEvents = False
  Exit Sub
ElseIf rep% = vbYes Then
  Application.EnableEvents = True
End If
Call myTimer
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not NoMake Then Call myTimer
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Not NoMake Then Call myTimer
End Sub

2) Copiez le code suivant dans un module standard (adaptez la constante MILLI_SECONDES à votre usage. L'essai est réglé sur 10 secondes)
Code:
'### Constante à adapter ###
Public Const MILLI_SECONDES As Long = 10000 '10 mn = 600000 (10 mn * 60 secondes * 1000 millièmes de seconde)
'###########################

Private Declare Function SetTimer& Lib "user32" _
  (ByVal hwnd As Long, ByVal nIDEvent As Long, _
  ByVal uElapse As Long, ByVal lpTimerFunc As Long)
Private Declare Function KillTimer& Lib "user32" _
  (ByVal hwnd As Long, ByVal nIDEvent As Long)
Private Declare Sub keybd_event Lib "user32.dll" ( _
  ByVal bVk As Byte, ByVal bScan As Byte, _
  ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
  
Const VK_RETURN = &HD
Const KEYEVENTF_EXTENDEDKEY = &H1
Const KEYEVENTF_KEYUP = &H2
  
Dim OnTimer&
Dim OnTimer2&
Public NoMake As Boolean

Private Sub CloseAfterDelai()
Call OffTimer
Application.OnTime Now + TimeValue("00:00:01"), "Fermeture"
End Sub

Private Sub SimuleEnter()
NoMake = True
ThisWorkbook.Activate
keybd_event VK_RETURN, 0, 0, 0
keybd_event VK_RETURN, 0, KEYEVENTF_KEYUP, 0
End Sub

Private Sub RunTimer(Delai&)
If OnTimer& > 0 Then OffTimer
OnTimer& = SetTimer(0, 0, ByVal Delai&, AddressOf CloseAfterDelai)
OnTimer2& = SetTimer(0, 0, ByVal Delai& - 100, AddressOf SimuleEnter)
End Sub

Private Sub OffTimer()
If OnTimer& > 0 Then
  OnTimer& = KillTimer(0&, OnTimer&)
  OnTimer& = 0
End If
If OnTimer2& > 0 Then
  OnTimer2& = KillTimer(0&, OnTimer2&)
  OnTimer2& = 0
End If
End Sub

Public Sub myTimer(Optional dummy As Byte)
Call OffTimer
OnTimer& = 0
Call RunTimer(Delai:=Time + MILLI_SECONDES)
End Sub

Private Sub Fermeture()
Dim WB As Workbook
For Each WB In Application.Workbooks
  If WB.Name <> ThisWorkbook.Name Then
    WB.Activate
    Exit For
  End If
Next WB
ThisWorkbook.Close savechanges:=True
End Sub

On utilise 2 timers API, l'un pour simuler Enter afin d'éviter le busy, l'autre pour lancer un OnTime de fermeture et l'opérateur
AddressOf pour 2 fonctions de rappel. Le classeur contenant ces codes sera seul fermé et l'application restera ouverte avec les éventuels
autres classeurs.

Bon courage.
Cordialement.

PMO
Patrick Morange
 

joebar2

XLDnaute Nouveau
Re : application.ontime en mode edition de cellule

Waouh ! Merci Patrick !!

ça c'est du code de Barbatruc où je ne m'y connais pas ...
Ton prog semble fonctionner comme je le souhaite.
Bon j'essaie de l'intégrer pour voir s'il n'y a pas d'interférences avec mes modestes macros et je vous tiens au courant. (demain parce que ce soir j'ai du taff).
 

joebar2

XLDnaute Nouveau
Re : application.ontime en mode edition de cellule

Bonjour à tous,

C'est bon j'ai réussi à intégrer le code.

Mais j'ai réalisé quelques modifs car dans mon prog original, j'affiche un userfom avec un compte à rebours (timer_usf) pour ne pas fermer le classeur comme un sauvage.

Un problème est apparu : plusieurs documents comportent cette macro de fermeture automatique et un utilisateur peut les ouvrir ou les modifier à quelques secondes d'intervalle. Les userforms "timer_usf" peuvent alors se chevaucher. D'où la solution du GIF animé pour afficher un compte à rebours sans utiliser de boucle.

D'autre part, pour sortir de l'édition de cellule, j'ai préféré envoyer un ESCAPE plutôt qu'un RETURN avec keybd_event car sinon cela valide le commandbutton d'un userform "timer_usf" éventuellement déjà affiché et ça relance un délai supplémentaire.

Pour ceux que cela intéresse je joins le classeur et le gif animé (à laisser dans le même répertoire que le classeur). Comme déjà dit, on peut ouvrir plusieurs classeurs contenant ces macros, c'est étudié pour.

Merci encore à Patrick pour son aide précieuse et à tous les contributeurs de ce forum.
 

Pièces jointes

  • test1_ok.zip
    24 KB · Affichages: 55
  • test1_ok.zip
    24 KB · Affichages: 60
  • test1_ok.zip
    24 KB · Affichages: 64
Dernière édition:

joebar2

XLDnaute Nouveau
Re : application.ontime en mode edition de cellule

Bonjour à tous,

J'ai modifié le classeur car j'ai fait une erreur dans Private Sub SimuleEnter()
j'ai oublié la ligne
keybd_event vk_ESCAPE, 0, KEYEVENTF_KEYUP, 0
après la ligne
keybd_event vk_ESCAPE, 0, 0, 0

Le bug etait fâcheux car il bloquait la touche escape en position enfoncée. Conséquence parmi d'autres : les icones du bureau ne sont plus déplaçables. Pour remédier à ce problème, il s'uffit d'appuyer sur la touche escape et ça revient.

Milles excuses pour ce souci, le nouveau fichier joint est exempt de ce bug.

Bebere : Désolé mais ton exemple ne convient pas car il ne répond pas à la problématique initiale : fermer le fichier automatiquement même si l'utilisateur est en train d'éditer une cellule. D'autre part si on ouvre un autre classeur après le tien, il met à jour les infos timeout, Hfin,... dans ce nouveau classeur et non dans le classeur que l'on veut fermer. Merci quand même pour cette proposition.

Je crois que je vais rester sur le code actuel qui fonctionne très bien.

Cordialement.
 

Pièces jointes

  • test1_ok.zip
    24 KB · Affichages: 61
  • test1_ok.zip
    24 KB · Affichages: 64
  • test1_ok.zip
    24 KB · Affichages: 59

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
312 493
Messages
2 088 956
Membres
103 990
dernier inscrit
lamiadebz