Discussion :

[adamgg]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[unparia]

Bonjour

Execute donc sans attendre par :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[adamgg]

Je ne comprends pas la démarche :/

[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 !

[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)

[Oliv-]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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é"

[cerede2000]

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

[unparia]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 !

[cerede2000]

Ok mais explique moi la différence de l’appeler comme ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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.

[adamgg]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 ?

[cerede2000]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[kiki29]

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

[adamgg]

Merci Kiki29 je vais essayer ça! je vous tiens au courant

[Nodens_swiss]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Application.OnTime Now + 0.000001 ‘1/10 sec

[adamgg]

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 ?

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Application.OnTime Now + 0.000001 ‘1/10 sec

Du coup on supprime la fonction Timer_timer1 ?

Merci pour vos réponses !