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à ;)
 

patricktoulon

XLDnaute Barbatruc
tiens robert teste celle ci le compteur ne décolle pas
un userform,un webbrowser,2 boutons start and stop
VB:
Private Sub CommandButton4_Click()
WebBrowser1.Document.parentWindow.execScript "chrono();", "javascript"
End Sub

Private Sub CommandButton5_Click()
WebBrowser1.Document.parentWindow.execScript "stopchrono();", "javascript"

End Sub

Private Sub UserForm_Activate()
With WebBrowser1
.Navigate "about:blank"
.Document.write "<html><head><script language=""JavaScript"">var timerID =0;var counter=0" & vbCrLf & _
"function chrono(){counter=counter+1;document.title=""xxx""+counter;timerID = setTimeout(""chrono()"", 1000);}" & vbCrLf & _
"function stopchrono(){clearTimeout(timerID);}" & vbCrLf & _
"</script></head><body ><script>chrono();</script></body></html>"
End With
End Sub


Private Sub WebBrowser1_TitleChange(ByVal Text As String)
Range("A1").Value = Format(Now, "hh:nn:ss")
End Sub
 

ChTi160

XLDnaute Barbatruc
Bonjour Patrick
Bonjour Robert
Bonjour le Forum
y'a t'il une référence particulière a cocher pour que ça fonctionne ?
car j'ouvre le fichier ,l'heure s'affiche bien en A1 ,le userorm affiche les deux Bouton et un Webbrowser mais rien de particulier ne s'affiche dedans et l'action sur les boutons ne fait rien.
merci par avance
jean marie
 

patricktoulon

XLDnaute Barbatruc
Bonjour ChTi160
il est pas prévu que ça fasse ou affiche quoi que ce soit dans ce webbrowser
c'est juste pour exécuter un timer en JS
et dans ce cas précis d'utiliser un events du controls
les events Etant internes ça ne passe donc pas par un looping VBA
c'est donc moins gourmand
les boutons démarre et arrête le timer (voir dans A1)

EN FAIT l'idée est de minuter une action répétitive sans que ça soit bloquant
a tester avec le userform non modal
 
Dernière édition:

Dudu2

XLDnaute Barbatruc
Bonjour les Experts,

Il est bien dommage qu'Application.Ready ne reflète pas vraiment la "readyness" de l'application.
C'est cette propriété qui devrait permettre de passer la fonction du Timer car on a aucun autre moyen de savoir si Excel est prêt à se prendre une exécution de fonction hors contexte.

Par exemple, un OnTime est suspendu pendant la saisie dans une cellule, et donc dispose d'informations dont on ne dispose pas et qui doivent être au niveau Application.

Au final le On Error, même si un peu rebutant car peu "élégant", reste la solution la plus simple, et peut-être la seule.
 

patricktoulon

XLDnaute Barbatruc
Bonjour Dudu2
oui tout a fait
on a bien un soucis pre/post réponse event interne de l'application
a ce jour je n'ai rien trouvé d'autre qui permettrait de minuter une action tout en libérant suffisamment l'application pour nous permettre de faire autre chose
ET SURTOUT QUE CA NE SOIT PAS GOURMAND EN RESSOURCE

NON RIEN!! a part mon astuce d'events commandbars qui est quasi invisible

exemple
module thisworkbook
VB:
Option Explicit
Private WithEvents Cmbrs As CommandBars    'creation de l'object commandbars events
Public delay As Long    ' delay d'affichage
Public t
'evenement commandbars
Private Sub Cmbrs_OnUpdate()
    Application.CommandBars.FindControl(ID:=2040).Enabled = Not Application.CommandBars.FindControl(ID:=2040).Enabled
    If Timer - t >= delay Then Ontimer Timer - t
End Sub
Public Sub go(): t = Timer: Set Cmbrs = Application.CommandBars: End Sub
Public Sub alt(): Set Cmbrs = Nothing: TimerOnStop Timer - t: End Sub

pour l'exploiter
exemple dans un module standard ou meme thisworkbook
des pseudo event timer :p:p:cool:;)
VB:
Sub starttimer(): ThisWorkbook.go: End Sub 'lance le timer
Sub Soptimer(): ThisWorkbook.alt: End Sub 'stop le timer

'pseudo events on timer
Sub Ontimer(Optional TimeElapsed As Double) 'action pendant le timer
[B1] = Format(Now, "hh:nn:ss")
[B2] = TimeElapsed
End Sub

'pseudo events timer stop
Sub TimerOnStop(Optional TimeElapsed As Double = 0)
MsgBox TimeElapsed
End Sub
 

Dudu2

XLDnaute Barbatruc
Nan, j'avais pas mis en Workbook, désolé.
Oui je me souviens de ton astuce évoquée dans un autre sujet. Ça peut bien le faire.

Pour avoir des timers sous la seconde, une autre solution serait d'essayer d'utiliser des OnTime déclenchés (et arrêtés) en série, disons sur des fractions de secondes 1/5, 1/4, 1/3, 1/2.
Bien à sûr à interfacer pour éviter les simplifier. Je n'ai aucune idée de la faisabilité. Je vais essayer.
 

Discussions similaires

Statistiques des forums

Discussions
312 071
Messages
2 085 049
Membres
102 766
dernier inscrit
Awiix