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
| Private Sub Pointer()
Me.TextBox1.Focus()
On Error GoTo ErreurOuvertureFichier
Conn.Open("Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & Fichierbase & ";" & _
"Jet OLEDB:Database Password=" & MotPasse)
On Error GoTo 0
Rst.Open("Select * from [Agents]", Conn)
Rst.Filter = "Code LIKE '" & CodeBarre & "'"
If Rst.RecordCount = 1 Then
Me.Label1.Text = Rst(2)
Me.Label1.BackColor = Color.Green
Numjour = Int(Now - CDate("1/1/" & Year(Now))) + 1
NumAgent = Year(Now) & "-" & Format(Numjour, "000") _
& "-" & Format(Rst(0), "00")
Rst.Close()
Rst.LockType = ADODB.LockTypeEnum.adLockOptimistic
Rst.Open("Select * from [Base]", Conn)
Rst.Filter = "Code LIKE '" & NumAgent & "%" & "'"
Select Case Rst.RecordCount
Case 0
Rst.AddNew()
Rst(0) = NumAgent & "-01"
Rst(1) = Now
Rst.Update()
Texte = "Début du service : "
son = "BeepOkDébut"
Case Else
Rst.MoveLast()
If Rst(2) Is Nothing Then
Rst(2) = Now
Rst.Update()
Texte = "Fin du service : "
Son = "BeepOkFin"
Else
Numpointage = Rst.RecordCount + 1
Rst.AddNew()
Rst(0) = NumAgent & "-" & Format(Numpointage, "00")
Rst(1) = Now
Rst.Update()
Texte = "Début du service : "
Son = "BeepOkDébut"
End If
End Select
Me.Label2.Text = Texte & Format(Now, "hh:mm")
'Run (son)
Rst.Close()
Conn.Close()
Me.TextBox1.Focus()
Exit Sub
Else
Me.Label1.Text = "Carte non reconnue. Recommencez"
Me.Label1.BackColor = Color.Red
Run("BeepPasOk")
Rst.Close()
Conn.Close()
End If
On Error Resume Next
Rst.Close()
Conn.Close()
Me.TextBox1.Focus()
Exit Sub
ErreurOuvertureFichier:
MsgBox("Ouverture du fichier de données impossible." & vbCrLf & _
"Contactez l'administrateur")
Exit Sub
End Sub |