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 |
