Précision et Timer

Version imprimable

Voir 40 message(s) de cette discussion en une page

28/04/2016, 11h30
adamgg

Précision et Timer

Bonjour,
Je mène actuellement une série de mesure.
Pour ce faire j'ai programmer un timer qui me permet de récupérer une mesure par seconde.
J'aimerais augmenter ma fréquence d'acquisition et évitant de changer tout le code. J'aimerais réalisé 5 mesures par secondes.
Voici mon code actuel

Code:

Application.OnTime Now + TimeValue("00:00:01"), "Timer1_Timer"

Comme les dates sont codé sur 8 octets je n'arrive pas à obtenir la précision voulue.
Comment peut-on contourner le problème ?

Merci d'avance
28/04/2016, 12h11
unparia

Bonjour

Execute donc sans attendre par :

Code:

Application.OnTime Now + TimeValue("00:00:00"), "Timer1_Timer"

et utilise la fonction Timer en condition d'exécution dans ta procédure Timer1_Timer
28/04/2016, 13h24
adamgg

Je ne comprends pas la démarche :/
28/04/2016, 13h28
cerede2000

Heu.....
En effet unparia tu nous explique....
La différence entre Application.OnTime Now + TimeValue("00:00:00"), "Timer1_Timer" et un lancement direct de la sub Timer1_Timer ????
Si on à pas d'attente (temps à 0) alors autant lancer le truc en direct !
28/04/2016, 14h37
unparia

Bonjour cerede20010
Tu crois ?
Hé bien ... On va attendre le demandeur***. Il saura peut-être comprendre, lui ...
Et je lui répondrai alors, s'il n'a pas "pigé", lui ...

*** (car le demandeur, c'est ... le demandeur)
28/04/2016, 14h52
cerede2000

Ah tiens du grand unparia dans toute sa splendeur de co......ie
Il y avait longtemps !

Tu "chiales" parce que cela t'échappe, cerede2000 ?
Et tuè "y vas" de tes "commentaires habituels et habituellement "intelligents" (qui n'ont pas leur place ici) ?
Alors regarde :

dans un module :
Code:

1 2 3 4 5 6 7 8 9 10 Public Function timer1_timer() Static deb As Double, nb As Integer '===>> juste pour t'éviter d'avoir à casser. S'arretera à 10 If deb = 0 Then deb = Timer If Timer - deb >= 0.2 Then Range("B10").Value = Range("B10").Value & "exécution à " & Timer & " secondes" & Chr(10) deb = Timer nb = nb + 1 End If If nb < 10 Then Application.OnTime Now, "Timer1_Timer" End Function
et maintenant l'appel (en exemple et testé) :
Code:

1 2 3 Private Sub CommandButton5_Click() Application.OnTime Now, "Timer1_Timer" End Sub
J'ai été gentil en arrêtant ce timer à 10 lignes (cela t'évitera de faire un ctrl-pause).
C'était pourtant tellement évident !

28/04/2016, 15h27
cerede2000
Ok mais explique moi la différence de l’appeler comme ça :
Code:

1 2 3 4 5 Sub test() Static nb As Integer nb = 0 timer1_timer End Sub
Qui fait bien la même chose...
Avec remise à 0 de nb quand même :mrgreen:
28/04/2016, 16h30
unparia

Si tu ne vois pas la différence, c'est que tu ne sais pas regarder ou n'as pas compris la demande formulée.

Il y a une énorme différence (entre autres de ressources) entre solliciter constamment et ne le faire que tous les "ticks" d'un timer.
Bon ... je pense que adamgg a sa solution.

EDIT : quant à la remise à 0 de nb, voire nb lui-même : nb n'était là que pour ton confort.
Je n'ai pas besoin d'une boule de cristal pour deviner que adamgg veut faire tourner cela (sans nb) durant toute la durée de vie de son appli (et devine même à quelles fins il en a besoin). Et son "timer" ne s'arrêterait alors qu'avec son appli. Et il peut se réserver (s'il le souhaite) la possibilité de l'interrompre sans aucun nb (juste avec une variable booléenne globale).

EDIT2 : et tu n'as peut-être pas compris que Appliçation.Ontime (comme un vrai timer, de VB6, par exemple, ou l'utilisation de AddressOf) "gère" le "tick" sur un autre fil, seules les instructions s'exécutant dans le fil d'appel. Ce qui n'est pas, loin de là, le cas d'une routine normale qui se rappelle elle-même.

Merci pour vos réponses.
J'ai essayé d'utiliser t'a méthode Unparia cependant le rafraichissement des infos que j'avais n'apparait plus.
Voici le code complet :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
Public Function timer1_timer()
   ReDim temp_buffer(9) As Single
  Dim overflow_flag As Integer
  Dim i As Integer
  Dim t1 As Integer
  Dim t2 As Integer
 
  Static deb As Double
  If deb = 0 Then deb = Timer
  If Timer - deb >= 0.2 Then
 
  If Cells(4, "B").Value < Cells(5, "A").Value Then Application.OnTime Now, "Timer1_Timer"
 
If UserForm1.CheckBox1 = True Then
 
  If (tc08_handle > 0) Then
    If (Not in_timer) Then
      in_timer = True
 
      ok = usb_tc08_get_single(tc08_handle, temp_buffer(0), overflow_flag, 0)
 
      If (ok) Then
       Cells(4, "A").Value = temp_buffer(0)
       Cells(4, "B").Value = temp_buffer(1)
       Cells(4, "C").Value = temp_buffer(2)
        Range("B4").Select
        Selection.Copy
        Cells(4, "D").Value = Cells(4, "D").Value + 1
        i = Cells(4, "D").Value
        t1 = Cells(4, "B").Value
        t2 = Cells(4, "C").Value
 
        If t1 > temperaturefindesaisie Then
            Cells(i, 1).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        End If
      End If
      in_timer = False
    End If
  End If
End If
If UserForm1.CheckBox2 = True Then
 
 
   If (tc08_handle > 0) Then
    If (Not in_timer) Then
     in_timer = True
 
      ok = usb_tc08_get_single(tc08_handle, temp_buffer(0), overflow_flag, 0)
 
      If (ok) Then
       Cells(4, "A").Value = temp_buffer(0)
       Cells(4, "B").Value = temp_buffer(1)
       Cells(4, "C").Value = temp_buffer(2)
       Range("C4").Select
        Selection.Copy
         If t2 > temperaturefindesaisie Then
            Cells(i, 4).Select
 
       Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
          End If
 
      End If
      in_timer = False
    End If
  End If
End If
 
'remplissage userform2
 
        UserForm2.Label2.Caption = Cells(4, "B").Value & " °c"
        UserForm2.Label4.Caption = Cells(4, "C").Value & " °c"
        UserForm2.Label6.Caption = Cells(4, "D").Value - 24 & " seconde"
    Worksheets("Saisie").ChartObjects("graphique 4").Activate
If i > 0 Then
    ActiveChart.SeriesCollection(1).XValues = "=Saisie!$C$25:$C$" & i
    ActiveChart.SeriesCollection(1).Values = "=Saisie!$A$25:$A$" & i
     ActiveChart.SeriesCollection(2).XValues = "=Saisie!$C$25:$C$" & i
     ActiveChart.SeriesCollection(2).Values = "=Saisie!$D$25:$D$" & i
End If
 
        Set LeGraph = Worksheets("Saisie").ChartObjects("graphique 4").Chart
        NomImage = ThisWorkbook.Path & Application.PathSeparator & "temp.gif"
        LeGraph.Export Filename:=NomImage, FilterName:="GIF"
        UserForm2.Image1.Picture = LoadPicture(NomImage)
 
   deb = Timer
End If
 
End Function

La fonction Timer est appelé dans un autre programme.

et voici l'ancien code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
Private Sub Timer1_Timer()
  ReDim temp_buffer(9) As Single
  Dim overflow_flag As Integer
  Dim i As Integer
  Dim t1 As Integer
  Dim t2 As Integer
 
If UserForm1.CheckBox1 = True Then
 
  If (tc08_handle > 0) Then
    If (Not in_timer) Then
      in_timer = True
 
      ok = usb_tc08_get_single(tc08_handle, temp_buffer(0), overflow_flag, 0)
 
      If (ok) Then
       Cells(4, "A").Value = temp_buffer(0)
       Cells(4, "B").Value = temp_buffer(1)
       Cells(4, "C").Value = temp_buffer(2)
        Range("B4").Select
        Selection.Copy
        Cells(4, "D").Value = Cells(4, "D").Value + 1
        i = Cells(4, "D").Value
        t1 = Cells(4, "B").Value
        t2 = Cells(4, "C").Value
 
        If t1 > temperaturefindesaisie Then
            Cells(i, 1).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        End If
      End If
      in_timer = False
    End If
  End If
End If
If UserForm1.CheckBox2 = True Then
 
 
   If (tc08_handle > 0) Then
    If (Not in_timer) Then
     in_timer = True
 
      ok = usb_tc08_get_single(tc08_handle, temp_buffer(0), overflow_flag, 0)
 
      If (ok) Then
       Cells(4, "A").Value = temp_buffer(0)
       Cells(4, "B").Value = temp_buffer(1)
       Cells(4, "C").Value = temp_buffer(2)
       Range("C4").Select
        Selection.Copy
         If t2 > temperaturefindesaisie Then
            Cells(i, 4).Select
 
       Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
          End If
 
      End If
      in_timer = False
    End If
  End If
End If
 
'remplissage userform2
 
        UserForm2.Label2.Caption = Cells(4, "B").Value & " °c"
        UserForm2.Label4.Caption = Cells(4, "C").Value & " °c"
        UserForm2.Label6.Caption = Cells(4, "D").Value - 24 & " seconde"
    Worksheets("Saisie").ChartObjects("graphique 4").Activate
If i > 0 Then
    ActiveChart.SeriesCollection(1).XValues = "=Saisie!$C$25:$C$" & i
    ActiveChart.SeriesCollection(1).Values = "=Saisie!$A$25:$A$" & i
     ActiveChart.SeriesCollection(2).XValues = "=Saisie!$C$25:$C$" & i
     ActiveChart.SeriesCollection(2).Values = "=Saisie!$D$25:$D$" & i
End If
 
        Set LeGraph = Worksheets("Saisie").ChartObjects("graphique 4").Chart
        NomImage = ThisWorkbook.Path & Application.PathSeparator & "temp.gif"
        LeGraph.Export Filename:=NomImage, FilterName:="GIF"
        UserForm2.Image1.Picture = LoadPicture(NomImage)
 
  If tc08_handle > 0 Then Application.OnTime Now + TimeValue("00:00:01"), "Timer1_Timer"
End Sub

Ces codes sont couplés avec des fonctions qui permettent la récupération d'information venant d'un boitier de mesure.
Ai-je commis une erreur ? ou mal compris une partie de la manip ?

Heu..... @unparia :
Je part toujours de ta fonction timer1_timer :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Public nb As Integer Public Function timer1_timer() Static deb As Double If deb = 0 Then deb = Timer If Timer - deb >= 0.2 Then Debug.Print "exécution à " & Timer & " secondes" & Chr(10) deb = Timer nb = nb + 1 End If If nb < 10 Then Application.OnTime Now, "Timer1_Timer" End Function
Que je la lance comme ceci :
Code:

1 2 3 4 5 6 7 8 9 Sub test() nb = 0 timer1_timer For i = 0 To 10000 Next Debug.Print "fini" End Sub
Ou comme ceci :
Code:

1 2 3 4 5 6 7 8 9 Sub test() nb = 0 Application.OnTime Now, "Timer1_Timer" For i = 0 To 10000 Next Debug.Print "fini" End Sub
La différence que je vois est très nette !
C'est que dans le premier cas le lancement de timer1_timer est immédiat (normal) et que le timer part ensuite en // de la fonction test
Alors qu'en la lançant avec Application.OnTime Now, "Timer1_Timer" il faudra attendre la fin de l’exécution de test avant qu'elle soit exécuté, ce qui est nettement moins intéréssant mais bon....

28/04/2016, 17h29
kiki29

Salut, @adamgg : voir ici en élaguant pour l'adapter à ton contexte.
28/04/2016, 17h44
adamgg

Merci Kiki29 je vais essayer ça! je vous tiens au courant
29/04/2016, 11h05
Nodens_swiss
Si je ne me trompe pas, la fonction peut être utilisé de la manière suivante :
Code:

1 2 Application.OnTime Now + 0.000001 ‘1/10 sec
04/05/2016, 13h50
adamgg
Citation:

Envoyé par kiki29

Salut, @adamgg : voir ici en élaguant pour l'adapter à ton contexte.

J'ai un peu du mal a comprendre le code, comment choisis-tu le delta temps dans ton code ?
Citation:
Envoyé par Nodens_swiss

Si je ne me trompe pas, la fonction peut être utilisé de la manière suivante :

Code:

1 2 Application.OnTime Now + 0.000001 ‘1/10 sec
Du coup on supprime la fonction Timer_timer1 ?

Merci pour vos réponses !

Salut, c'est pourtant très clair : il y a
Code:

1 2 3 4 5 Sub TimerOn(Interval As Long) TimerID = SetTimer(0, 0, Interval, AddressOf Maj) End Sub TimerOn 100
ou 100 correspond à 100 ms il me semble.

Citation:

Envoyé par cerede2000

Heu.....
En effet unparia tu nous explique....
La différence entre Application.OnTime Now + TimeValue("00:00:00"), "Timer1_Timer" et un lancement direct de la sub Timer1_Timer ????
Si on à pas d'attente (temps à 0) alors autant lancer le truc en direct !

Il y a des cas où le lancement direct ne fonctionne pas notamment avec certains événements où il faut que l'événement soit fini pour pouvoir modifier l'objet de cet événement.

J'avais aussi eu le problème avec des Macro lancées par un bouton d'une CommandBars (xla) de l'onglet complément qui ne permettait pas d'avoir la main pour sélectionner une zone sur un autre classeur avec une méthode Application.InputBox
Code:

1 2 Set Colonne = Application.InputBox(prompt:="Sélectionner avec la souris le FICHIER et la COLONNE ou se trouvent NOS " & TexteBoite _ & vbCr & Texterreur, Title:="1ère colonne " & TexteBoite, Type:=8)
et dans ces 2 cas "Application.OnTime" a été la solution, pour un lancement "direct/décalé"

Citation:

Envoyé par kiki29

Salut, c'est pourtant très clair : il y a ou 100 correspond à 100 ms il me semble.

Ok j'avais pas vu la ligne désolé. J'insère donc un Timeron 20 dans mon programme Timer1_Timer.
Cependant il me renvoi une erreur de compilation dû a une variable non définie le AdressOf Maj en l’occurrence
Code:

1 2 3 4 Sub TimerOn(Interval As Long) TimerID = SetTimer(0, 0, Interval, AddressOf Maj) End Sub
Il m'envoyé la même erreur pour le "legraph" du code permettant de changer le graph en image et d'afficher l'image:
Code:

1 2 3 4 Set legraph = Worksheets("Saisie").ChartObjects("graphique 4").Chart NomImage = ThisWorkbook.Path & Application.PathSeparator & "temp.gif" legraph.Export Filename:=NomImage, FilterName:="GIF" UserForm2.Image1.Picture = LoadPicture(NomImage)
Il faut donc que je déclare ces variables, mais j'ignore le type de variable pour l'Adressof Maj et je suppose que legraph est une image non ?
Merci
Citation:
Envoyé par Oliv-
Il y a des cas où le lancement direct ne fonctionne pas notamment avec certains événements où il faut que l'événement soit fini pour pouvoir modifier l'objet de cet événement.

J'avais aussi eu le problème avec des Macro lancées par un bouton d'une CommandBars (xla) de l'onglet complément qui ne permettait pas d'avoir la main pour sélectionner une zone sur un autre classeur avec une méthode Application.InputBox
Code:

1 2 Set Colonne = Application.InputBox(prompt:="Sélectionner avec la souris le FICHIER et la COLONNE ou se trouvent NOS " & TexteBoite _ & vbCr & Texterreur, Title:="1ère colonne " & TexteBoite, Type:=8)
et dans ces 2 cas "Application.OnTime" a été la solution, pour un lancement "direct/décalé"
D'acc je comprends l'astuce merci

04/05/2016, 16h10
Oliv-
tu peux les déclarer en variant
Code:

1 2 Dim legraph
04/05/2016, 16h19
adamgg

Merci ça marche pour legraph mais pas pour le AddressOf le programme réclame un identificateur.

Voir 40 message(s) de cette discussion en une page