XL 2013 La colle du jour(n'y a t il pas d'autre moyen que la gestion d'erreur)

[patricktoulon]

bonjour a tous
comme le titre l'indique je souhaiterais savoir si il y a un moyen de se passer de la gestion d'erreur
j'explique
l'horloge fonctionne mais des que je sélectionne une cellule ou une plage le timer plante excel quand heure est appelée
les gestion d'erreur c'est bien mais j'aimerais comprendre comment on peut gérer autrement

#If VBA7 Then
    Private Declare PtrSafe Function SetTimer Lib "user32.dll" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As Long
    Private Declare PtrSafe Function KillTimer Lib "user32.dll" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long) As Long
#Else
    Private Declare Function SetTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As Long
    Private Declare Function KillTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
#End If
Dim TimerID&
Sub start()
TimerID = SetTimer(0, 0, 100, AddressOf heure)
End Sub
 
Sub arret()
On Error Resume Next
If TimerID <> 0 Then KillTimer 0, TimerID: TimerID = 0:
End Sub
 
Sub heure()
On Error Resume Next
[A1] = Format(Now, "hh:nn:ss")
End Sub

je vois arriver a grand pas Dranreb là

 

[Dranreb]

Bonjour
Je n'ai pas de solution pour arriver à faire exécuter une requête Excel par un timer sans que cela ne fasse planter brutalement l'application, à moins qu'une seule ne la fasse pas planter: un Application.OnTime Now, ce que je n'ai pas vérifié. Si c'était le cas, on devrait pouvoir différer l'action jusqu'au moment où il sera en mesure de l'effectuer.

 

[patricktoulon]

re Bonjour Dranreb

oui mais alors le timer serait faux et je ne sais pas si c'est post ou pre events que l'erreur se produit en interne
ça serait intéressant de trouver l'explication

 

[Dranreb]

Ce ne serait d'ailleurs probablement pas suffisant, il faudait noter Now dans une variable globale, d'abord, après avoir vérifié si elle n'est pas déjà initialisée, et la remettre à 0 dans la procédure planifiée. Il ne s'agirait pas d'exécuter des milliards de Application.OnTime Now pendant qu'il est en mode édition d'une cellule, je pense que ça planterait aussi !
Now ou moins comme heure planifiée dans un OnTime signfie en réalité 'dès que possible à partir de maintenant'.

 

[patricktoulon]

re
oui donc set timer serait obsolète dans le sens ou il n'aurait plus vraiment d'utilité sinon que quelque fois ou ça serait libre et même là difficile d'en contrôler la syncro
je vais faire des recherche du coté des api voir si on peu supplanter la sub exécutée en addressof
j'ai une petite idée que je vais tester déjà sans api

 

[patricktoulon]

ok donc c'est vraiment l'inscription dans A1 qui plante excel et non pas l'execution de la sub pendant une sélection
pour déroger j'ai ajouté la condition pour ne pas inscrire l'heure si la sélection est différente par rapport au moment ou le timer a été lancé et la variable est mis a jour
ça a l'air de fonctionner
c'est déjà plus précis
il va me falloir trouver le moyen d'intercepter le change peut etre
donc comme ceci je peux sélectionner ça ne met pas l'horloge a jour c'est tout
c'est juste l'histoire d'un tour et tant que la sélection change

Option Explicit
#If VBA7 Then
    Private Declare PtrSafe Function SetTimer Lib "user32.dll" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As Long
    Private Declare PtrSafe Function KillTimer Lib "user32.dll" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long) As Long
#Else
    Private Declare Function SetTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As Long
    Private Declare Function KillTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
#End If
Dim TimerID&
Dim oldrange As Range
Sub start()
Set oldrange = Selection
TimerID = SetTimer(0, 0, 100, AddressOf heure)
End Sub
 
Sub arret()
'On Error Resume Next
If TimerID <> 0 Then KillTimer 0, TimerID: TimerID = 0:
End Sub
 
Sub heure()
'On Error Resume Next'gestion d'erreur supprimée
If Selection.Address = oldrange.Address Then [A1] = Format(Now, "hh:nn:ss")
Set oldrange = Selection
End Sub

 

[dysorthographie]

bonjour Patrick,
tu peux utiliser un webbroser et recharger la page!

<html>
<head>
<meta http-equiv="refresh" content="1" />
</head>
<body>
</body>
</html>

et utiliser l’événement DocumentComplete comme déclencheur!

 

[Hasco]

Bonjour,

A tenter :

Sub heure()
If Application.Ready And Application.CalculationState = xlDone Then [A1] = Format(Now, "hh:nn:ss")
End Sub

Cordialement

 

[patricktoulon]

Ah!!.. je vois que le sujet intéresse un peu quand même
Bonjour @Roblochon ,dysorthographie
je vais tester l'idée de @Roblochon pour rester sur settimer et ensuite je testerais ton idée robert

 

[patricktoulon]

re
bon méthode Roblochon testée validée

 

[patricktoulon]

allez va y robert envoie la sauce
comment tu ferais ?
ps: je sais faire un timer en JS c'est de çà que tu parle

 

[patricktoulon]

haie!!!haie!!haie!!! j'ai parlé trop vite
non Roblochon çà plante quand tu tape quelque chose dans une autre cellule

 

[dysorthographie]

ce code html suffit à recharger la page et déclencher les événements du WebBrowser!

code HTML à placer dans le WebBrowser!

<html>
<head>
<meta http-equiv="refresh" content="1" />
</head>
<body>
</body>
</html>

il n'y a rien d'autre à faire que de gérer l’événement DocumentComplete du WebBrowser

 

[patricktoulon]

j'ai peur de ne pas avoir compris çà ne fonctionne pas

testé dans un userform

Private Sub UserForm_Activate()
With WebBrowser1
.Navigate "about:blank"
.Document.write "<html><head><meta http-equiv=""refresh"" content=""1"" /></head><body></body></html>"
End With
End Sub


Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
TextBox1 = Now
WebBrowser1.Document.Refresh
End Sub

 

[dysorthographie]

désolé!

Private Sub UserForm_Initialize()
    Dim FileNumber As Long
     FileNumber = FreeFile
    Open ThisWorkbook.Path & "\reload.html" For Output As #FileNumber
    Print #FileNumber, "<html><head><meta http-equiv=""refresh"" content=""1"" /></head><body></body></html>"
    Close #FileNumber
    With Me.WebBrowser1
    .Navigate ThisWorkbook.Path & "\reload.html"
         Do: DoEvents: Loop While .ReadyState <> 4 Or .Busy
    End With
End Sub
Private Sub WebBrowser1_DownloadComplete()
ThisWorkbook.Sheets("Feuil1").Range("A1") = Now
DoEvents
End Sub