Timer depuis bouton

**tat2398** · 22/11/2019, 12h00

Bonjour à tous et à toutes ,

Je souhaite pour le bien d'un projet ouvrir un timer par le biais. Le timer va lire dans un fichier à intervalle régulier (cette marche très bien ).
cependant je n'arrive pas à utiliser mon timer (ici je le test sans la procedure juste pour le tester)
voici mon code dans un module

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
Option Compare Database
 
 
 
Option Explicit
 
' Intervalle du timer en millisecondes
Private Const INT_TIMER As Long = 1000
' Déclaration d'API pour timer
Private Declare PtrSafe Function APISetTimer Lib "user32.dll" Alias "SetTimer" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerProc As Long) As Long
Private Declare PtrSafe Function APIKillTimer Lib "user32.dll" Alias "KillTimer" (ByVal hwnd As Long, ByVal uIDEvent As Long) As Long
' Constante définissant les timers
Private Const IDT_TIMER As Long = 1
'Private Const IDT_TIMER2 As Long = 2
 
' Démarre le timer (numéro du timer, interval en ms)
Private Sub Start_Timer(nIDEvent As Long, interval As Long)
If gCollTimer Is Nothing Then Set gCollTimer = New Collection
gCollTimer.Add gCollTimer, CStr(nIDEvent)
APISetTimer Application.hWndAccessApp, nIDEvent, interval, AddressOf gCollTimer.Callback_Timer
End Sub
' Arrête le timer
Private Sub Stop_Timer(uIDEvent As Long)
APIKillTimer Application.hWndAccessApp, uIDEvent
gCollTimer.Remove CStr(uIDEvent)
End Sub
 
Public Function Callback_Timer(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error Resume Next
Select Case wParam
Case IDT_TIMER
Call Evenement_Timer
'Case IDT_TIMER2
' Call Evenement_Timer2
End Select
End Function
' Affichage de l'heure à chaque seconde
Private Sub Evenement_Timer()
'SysCmd acSysCmdSetStatus, Now()
Debug.Print Now
End Sub
' Démarrage de l'horloge
Public Function Start_Test_Timer()
Start_Timer IDT_TIMER, INT_TIMER
End Function
' Arrêt de l'horloge
Public Function Stop_Test_Timer()
Stop_Timer IDT_TIMER
End Function

j'ai une erreur avec adressOF qui me dit "utilisation incorrecte d'AdressOF"
et voici mon code dans un module de classe

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
' Callback_Timer est appelé par les timers à intervalle régulier
Public Function Callback_Timer(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
' Citation de l'aide de AddressOf :
'Étant donné que l'appelant d'un rappel ne se trouve pas dans votre programme,
'il est important qu'une erreur rencontrée dans la procédure de rappel ne se propage pas
'dans l'appelant. Pour ce faire, insérez l'instruction On Error Resume Next
'au début de la procédure de rappel.
Dim ltimer As clTimer
On Error Resume Next
If gCollTimer Is Nothing Then Set gCollTimer = New Collection
Set ltimer = gCollTimer.Item(CStr(wParam))
ltimer.Callback_Timer hwnd, uMsg, wParam, lParam
End Function

je ne sais pas si vous avez des idées pour mon aide.

Merci beaucoup et bonne journée

**Arkham46** · 22/11/2019, 13h23

Bonjour,

addressOf ne peut être utilisé pour cibler la procédure d'un module de classe.

Pour votre besoin, la minuterie d'un formulaire masqué n'est pas suffisante ?

**tat2398** · 22/11/2019, 13h39

Bonjour et merci pour votre réponse .
Mon but est de lire à intervalle régulier quand on appuie sur un bouton un fichier si le fichier à changer entre temps je récupère la ligne et le traite dans access.
Je vous avoues que si il peut qu'un formulaire caché suffise cependant j'ai lu votre tuto mais je n'ai malheureusement pas compris à quel endroit vont les choses et surtout comment le bouton appel le start et le stop
pouvez-vous m'éclairez?

merci d'avance

**Arkham46** · 22/11/2019, 13h45

Je ne saurais que trop vous déconseiller d'utiliser du code que vous ne comprenez pas (surtout ce genre de code avec des API).

Créez un formulaire avec un événement sur minuterie et un intervalle de minuterie.
Et ouvrez ce formulaire masqué.
Si besoin d'avoir plusieurs minuteries en même temps, il faut ouvrir plusieurs instances du formulaire.

**tat2398** · 22/11/2019, 14h00

je comprends le code mais je ne comprends pas comment je peux l'appeler depuis le bouton et je ne pas créer de formulaire caché car dans mon traitement j'ai besoin d'élément du formulaire qui contient mon bouton pour faire un insert et aussi l'affichage se passe dans se même formulaire...
mais merci tout de même pour le conseil.

**tat2398** · 29/11/2019, 12h50

Bonjour,
je me permet de relancer la discussion comme j'ai ce projet uniquement le vendredi..
J'ai compris comment fonctionne l'API et à quoi sert AdressOf j'ai donc mis le Callback_timer dans un module simple cependant quand je l'appelle j'ai une erreur de type incompatibilité de type et je ne comprends pas pourquoi
Merci pour votre aide

**tat2398** · 06/12/2019, 08h15

Bonjour,
Je suis désolée de " pourrir le forum " avec mon problème de timer mais j'en ai absolument besoin cependant je sèche la-dessus ...
j'ai un problème d'incompatibilité de type sur mon adressOf et je ne comprends vraiment pas pourquoi car dans un modules à pars j'ai actuellement ceci

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
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
Option Compare Database
'variable globale récupération de temps
Public var_recup_temps_global As String
 
'
' Intervalle du timer en millisecondes
Private Const INT_TIMER As Long = 7000
 Déclaration d 'API pour timer
 Declare PtrSafe Function APISetTimer Lib "user32.dll" Alias _
    "SetTimer" (ByVal hWnd As Long, ByVal nIDEvent As Long, _
     ByVal uElapse As Long, ByVal lpTimerProc As Long) As Long
 Declare PtrSafe Function APIKillTimer Lib "user32.dll" Alias _
    "KillTimer" (ByVal hWnd As Long, ByVal uIDEvent As Long) As Long
' Constante définissant les timers
Private Const IDT_TIMER As Long = 1
Private Const IDT_TIMER2 As Long = 2
 Function Callback_Timer(ByVal hWnd As Long, ByVal uMsg As Long, _
                ByVal wParam As Long, ByVal lParam As Long) As Long
' Citation de l'aide de AddressOf :
'Étant donné que l'appelant d'un rappel ne se trouve pas dans votre programme,
'il est important qu'une erreur rencontrée dans la procédure de rappel ne se propage pas
'dans l 'appelant. Pour ce faire, insérez l'instruction On Error Resume Next
'au début de la procédure de rappel.
'On Error Resume Next
 
    Select Case wParam
      Case IDT_TIMER
        Call Evenement_Timer
      Case IDT_TIMER2
        Call Evenement_Timer2
    End Select
 
End Function
 
Private Sub Start_Timer(nIDEvent As Long, interval As Long)
 
  var_recup_temps_global = recup_temps
   MsgBox var_recup_temps_global
APISetTimer Application.hWndAccessApp, nIDEvent, interval, _
       AddressOf Callback_Timer ' Ligne pour les autres versions
 
End Sub
 
'
' Arrête le timer
Private Sub Stop_Timer(uIDEvent As Long)
 
    APIKillTimer Application.hWndAccessApp, uIDEvent
 
End Sub
'
' Callback_Timer est appelé par les timers à intervalle régulier
'
'
' Affichage de l'heure à chaque seconde
Private Sub Evenement_Timer()
 
 Dim recup_temps_fich As String
 
 
 Dim cible As Double
 Dim tol_min As Double
 Dim tol_max As Double
 Dim nomOp As String
 Dim cibleOp1 As Double
 Dim Tol_minOp1 As Double
 Dim tol_maxOp1 As Double
 Dim id_lay As Integer
 Dim db As Database
 Dim rst As Recordset
 Dim rst2 As Recordset
 Dim SqlQuery As String
 Dim SqlQuery2 As String
 Dim SqlInsert As String
 Dim reponse As String
  Dim varTemps As String
 Dim fichier_texte As String
Dim Today
Today = Now
Today = DateValue(Today)
      Set db = CurrentDb
 
 id_lay = 1
 
'recup_temps_fich = recup_temps
' MsgBox recup_temps_fich
 
 
            SqlQuery = ("SELECT nom_attri,cible,tol_min,tol_max FROM LBSA_CCTRL_attrib WHERE id_lay =" & id_lay)
            Set rst = db.OpenRecordset(SqlQuery)
Debug.Print SqlQuery
            SqlQuery2 = ("SELECT mesure_axe_x, mesure_axe_y, mesure_axe_z, mesure_axe_q from LBSA_CCTRL_Txt")
            Set rst2 = db.OpenRecordset(SqlQuery2)
Debug.Print SqlQuery2
 
'====================================================================================================================
 On Error Resume Next
    If var_recup_temps_global <> recup_temps Then
    Do While Not rst.EOF
 
            msg = MsgBox("l'heure a changé")
 
            nomOp = rst![nom_attri]
            cibleOp1 = rst![cible]
            Tol_minOp1 = rst![tol_min]
            tol_maxOp1 = rst![tol_max]
 
     '   MsgBox rst.Fields("nom_attri").Value & " " & rst.Fields("cible").Value & " " & rst.Fields("tol_min").Value & " " & rst.Fields("tol_max").Value
 
 
           importer_fichier
            MsgBox "importation des valeurs"
          Do While Not rst2.EOF
             MsgBox "deuxième boucle"
              cible = rst2![mesure_axe_z]
            tol_min = rst2![mesure_axe_y]
            tol_max = rst2![mesure_axe_x]
               MsgBox "récup des valeurs"
                 If cibleOp1 = cible Then
                                     reponse = "Conforme"
                                 If IsNumeric(id_lay) Then id_lay = CLng(id_lay)
                            SqlInsert = "INSERT INTO LBSA_CCTRL_Mesure (id_cartes_Layout,id_pieces, mesures_date, mesure_decisions,mesure_nbre_de_piece_controle,mesure_nbre_de_mesure) values(" & Chr(34) & id_lay & Chr(34) & "," & Chr(34) & frm!info_article.or_fab & Chr(34) & "," & Chr(34) & frm!info_article.date & Chr(34) & "," & Chr(34) & reponse & Chr(34) & "," & Chr(34) & frm!info_article.nbr_mesure_pièces & Chr(34) & "," & Chr(34) & frm!info_article.num_piece & Chr(34) & ") "
                                DoCmd.RunSQL SqlInsert
                                   MsgBox "prem test"
                  Else
                    If Tol_minOp1 < tol_min Or tol_maxOp1 > tol_max Then
                             reponse = "non-Conforme"
                              If IsNumeric(id_lay) Then id_lay = CLng(id_lay)
                            SsqlInsert = "INSERT INTO LBSA_CCTRL_Mesure (id_cartes_Layout, mesure_decisions) values(  " & id_lay & ", '" & reponse & "') "
                              DoCmd.RunSQL SsqlInsert
                               MsgBox "deuxième test"
                                Debug.Print SqlInsert
 
                            Else
 
                                      reponse = "Conforme"
                   If IsNumeric(id_lay) Then id_lay = CLng(id_lay)
                            SqlInsert = "INSERT INTO LBSA_CCTRL_Mesure (id_cartes_Layout,id_pieces, mesures_date, mesure_decisions,mesure_nbre_de_piece_controle,mesure_nbre_de_mesure) values(" & Chr(34) & id_lay & Chr(34) & "," & Chr(34) & frm!info_article.piece_Reglage & Chr(34) & "," & Chr(34) & frm!info_article.date & Chr(34) & ",'" & Chr(34) & reponse & Chr(34) & "'," & Chr(34) & frm!info_article.nbr_mesure_pièces & Chr(34) & "," & Chr(34) & frm!info_article.num_piece & Chr(34) & ") "
                                DoCmd.RunSQL SqlInsert
                                 MsgBox "troisième test"
                     End If
                  End If
                  recup_temps = var_recup_temps_global
 MsgBox "Insertion des valeurs"
 
                      rst2.MoveNext
                      Loop
    rst.MoveNext
 
 
 
        Loop
        Else
   rst.Close
    rst2.Close
 
 MsgBox "pas de changement d'heure"
 
     End If
            ' rst = Nothing
             'db = Nothing
 
 
        ' rst2.Close
 
        db.Close
 
        Exit Sub
ErrorHandler:
    MsgBox Err.Number & vbLf & Err.Description
End Sub
 
' Démarrage de l'horloge
Public Function Start_Test_Timer()
 
    Start_Timer IDT_TIMER, INT_TIMER
 
End Function
'
' Arrêt de l'horloge
Public Function Stop_Test_Timer()
 
    Stop_Timer IDT_TIMER
 
End Function

et dans mon code du bouton j'ai ceci

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Private Sub bt_enclencher_Click()
If IsNull(num_piece) Or IsNull(operateur_nom) Then
   msg = MsgBox(" Vous avez pas inscrit la progression de la série  et / ou le nom d'opérateur")
  Exit Sub
 
 
 
   Call Start_Test_Timer
   Me.bt_stop_mes.Visible = True
   Me.ssform_mesure_info_article.Visible = True
   Me.bt_stop_mes.SetFocus
   Me.bt_enclencher.Visible = False
End Sub

je suis encore désolé de vous embêter avec ceci mais celà m'embête de ne pas réussir alors que je fais comme sur tout les tuto...
merci enormement pour votre aide

**Jean-Philippe André** · 06/12/2019, 17h50

Salut,

utiliser des API sans savoir les adapter, c'est téméraire.

Tu es en 64bits, pas en 32bits

C'est un sujet déjà débattu ici
https://www.developpez.net/forums/d1...dressof-win64/

indice :
Long en LongPtr

**Arkham46** · 06/12/2019, 18h51

Bonjour,

Il n'est pas utile de créer une nouvelle discussion. J'ai fusionné les deux.

Ajouter PtrSafe n'est pas suffisant :
https://arkham46.developpez.com/arti...ice/vba64bits/

Manifestement, le code n'est pas maîtrisé.

Encore une fois, pourquoi ne pas utiliser la minuterie d'un formulaire ?

**tat2398** · 13/12/2019, 07h29

Bonjour merci de votre réponse,
car mon chef ne souhaite pas de nouveau formulaire de plus si j'utilise un formulaire caché il simule tout de même une ouverture donc celà se voit. Pour un travail d'école ce n'est pas grave mais pour une entreprise c'est niet.

Merci pour votre lien.
une bonne journée

**Arkham46** · 13/12/2019, 07h53

Bonjour,

Un formulaire caché ça ne se voit pas.
Et c'est plus facile pour trouber quelqu'un poir la maintenance.

Sinon il faut que la fonction de rappel soit dans un module standard, est-ce le cas ?

**tat2398** · 13/12/2019, 11h55

Merci pour votre réponse.
Alors oui il est caché mais quand je l'active il s'ouvre mais très rapidement on en voit que les contours et cela me déplaît.
Et pour répondre oui Callback est dans un module et non dans un module de classe.
Merci beaucoup et bon apétit

**Arkham46** · 13/12/2019, 12h19

Bonjour,

La conversion vers 64 bits n'est pas correct.
Les déclarations API n'ont pas été adaptées.

Pour le formulaire caché, c'est étonnant qu'on le voit.
Il me semble bien qu'on peut "ouvrir" un formulaire de manière totalement transparente.

**Arkham46** · 13/12/2019, 13h30

Pour le formulaire caché :

1 - créer un nouveau formulaire (totalement vierge, il ne sert que pour son événement minuterie)
2 - appelez-le par exemple FormTimer
3 - dans ses propriétés, préciser l'intervalle de minuterie et créer la procédure événementielle "Sur minuterie"

Pour l'appeler :
1 - déclarer une variable en en-tête du module du formulaire qui exécute l'action sur clic : dim oFormTimer as Form_FormTimer.
2 - à la place de l'appel à Start_Test_Timer, instancier ce formulaire set oFormTimer = new Form_FormTimer.
Le formulaire est alors chargé mais pas affiché ; la minuterie s'exécute : c'est la procédure événementielle Form_Timer qui est exécutée à intervalle régulier.

Un set oFormTimer = Nothing arrêtera le timer.
De même que la fermeture du formulaire appelant qui détruira l'objet oFormTimer.

Si besoin de plusieurs minuteries en même temps, ou si on souhaite pas mettre le code dans ce formulaire de minuterie (ce qui est légitime), il est possible faire quelque chose avec WithEvents du moment que l'appelant est un module de classe (ou module de formulaire).
On peut alors avoir plusieurs instances du formulaire de minuterie, qui lèvent chacune un événement traité dans chacun des appelants.
Le formulaire de minuterie devient réutilisable et pas dédié à une tâche en particulier (c'est ce qu'il faut faire pour faire bien).

En tout cas c'est standard, fiable, compréhensible et maintenable par n'importe qui, facile à documenter, et ne posera pas de problème de compatibilité 32/64bits.
C'est pour cela que j'insiste un peu, je suis persuadé qu'on peut faire quelque chose de bien avec le standard Access.
Les API on les utilisent en dernier recours et lorsqu'on sait qu'on a le support qui va suivre pour faire vivre l'outil.

Timer depuis bouton

VBA Access

Discussions similaires

Partager

Partager