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

patricktoulon · 29 Août 2020

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

VB:

#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 · 29 Août 2020

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 · 29 Août 2020

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 · 29 Août 2020

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 · 29 Août 2020

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 · 29 Août 2020

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

VB:

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 · 29 Août 2020

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

VB:

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

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

Hasco · 29 Août 2020

Bonjour,

A tenter :

VB:

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

Cordialement

patricktoulon · 29 Août 2020

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 · 29 Août 2020

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

patricktoulon · 29 Août 2020

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 · 29 Août 2020

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

dysorthographie · 29 Août 2020

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

code HTML à placer dans le WebBrowser!

VB:

<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 · 29 Août 2020

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

testé dans un userform

VB:

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 · 29 Août 2020

désolé!

VB:

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

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

patricktoulon

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

Hasco

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

Discussions similaires