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

patricktoulon

XLDnaute Barbatruc
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

XLDnaute Barbatruc
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.
 

Dranreb

XLDnaute Barbatruc
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'.
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
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

XLDnaute Barbatruc
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
 
Dernière édition:

dysorthographie

XLDnaute Accro
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!
 
Dernière édition:

dysorthographie

XLDnaute Accro
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

XLDnaute Barbatruc
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

XLDnaute Accro
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
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 907
Membres
101 836
dernier inscrit
karmon