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 186 187 188 189 190 191
| Private Sub Commande41_Click()
Dim Bds As DAO.Database
Dim RstPersonne As DAO.Recordset
Dim RstPointage As DAO.Recordset
Dim RstAbsence As DAO.Recordset
Dim Rq As String
Dim req As String
'Dim Pausedej As Integer
Dim PartDecim As Integer
Dim Absence As Integer
Dim i As Integer
Dim HeureDeb As Integer
Dim HeureFin As Integer
Dim vardate As Date
vardate = Format(TxtDate, "mm/dd/yyyy")
Set Bds = CurrentDb
Rq = "SELECT Persacces.per_code_acc AS code FROM Persacces"
Set RstPersonne = Bds.OpenRecordset(Rq)
If RstPersonne.RecordCount > 0 Then 'Le salarié existe-t-il ?
'RstPersonne.MoveLast
RstPersonne.MoveFirst
While Not RstPersonne.EOF 'Fin du Recordset
'ajout du parcours entre 2 dates
Rq = "SELECT pointage.Poin_date, pointage.Poin_no_carte, pointage.Poin_heure, pointage.Poin_minute FROM pointage WHERE (((pointage.Poin_date)= #" & vardate & "# )) AND ((pointage.Poin_no_carte) = '" & RstPersonne!code & "') ORDER BY pointage.Poin_heure;"
Set RstPointage = Bds.OpenRecordset(Rq)
nbpointage = RstPointage.RecordCount
If nbpointage > 0 Then 'Vérifier le nombre de pointage
'RstPointage.MoveLast
RstPointage.MoveFirst
If RstPointage.RecordCount Mod 2 = 1 Then
'Nombre d'enregistrement impair : Message d'erreur de pointage
CurrentDb.Execute "INSERT INTO ERREUR_POINTAGE ([IDsalarie], [date], [Motif]) Values(" & RstPersonne!code & ", #" & vardate & "#, ""Un nombre d'entrées/sorties impairs"" )"
'Exit Sub
End If
Select Case RstPointage.RecordCount
Case 2
For i = 1 To 1
RstPointage.MoveLast
HeureFin = RstPointage!poin_heure
MinuteFin = RstPointage!Poin_minute
HeureHM = HeureFin & ":" & MinuteFin
'Traitement du cas où le salarié quitte l'entreprise avant 17h30
If HeureFin <= "1730" Then
'Vérification d'une absence justifiée
req = "SELECT EST_ABSENT.DateAbsence, Motif, IDsalarie, EST_ABSENT.IDSalarie FROM EST_ABSENT WHERE EST_ABSENT.DateAbsence= #" & vardate & "# AND EST_ABSENT.IDsalarie = '" & RstPersonne!code & "' "
Set RstAbsence = Bds.OpenRecordset(req)
If RstAbsence.RecordCount > 0 Then
mes = MsgBox("Le salarié " & LstSalarie.Column(1) & " s'est absenté en date du " & vardate & " pour le motif suivant : " & RstAbsence!Motif & ".", vbInformation, "RH")
Else
mes = MsgBox("Le salarié " & LstSalarie.Column(1) & " ne dispose d'aucune absence justifiée !", vbCritical, "RH")
End If
CurrentDb.Execute "INSERT INTO ERREUR_POINTAGE ([IDsalarie], [date], [Motif]) Values(" & RstPersonne!code & ", #" & vardate & "#, ""Sortie précédant l'heure de sortie (17H30)"" )"
Else
Absence = 0
Pausedej = 0
End If
Next i
Case 4
For i = 1 To 1
RstPointage.Move (1)
HeureDeb = RstPointage!poin_heure
MinuteDeb = RstPointage!Poin_minute
HeureHMDeb = HeureDeb & ":" & MinuteDeb
MsgBox (HeureHMDeb)
RstPointage.MoveNext
'RstPointage.MoveFirst
HeureFin = RstPointage!poin_heure
MinuteFin = RstPointage!Poin_minute
HeureHMFin = HeureFin & ":" & MinuteFin
MsgBox (HeureHMFin)
RstPointage.MoveNext
If HeureHMDeb >= "12" And HeureHMFin <= "14" Then
'If HeureHMDeb >= "1200" And HeureHMDeb <= "1400" And HeureHMFin >= "1200" And HeureHMFin <= "1500" Then 'Assembler HH:MM
' Absence = 0
'Calcul de l'heure de dej
HeureHMFin = TimeSerial(HeureFin, MinuteFin, 0)
HeureHMDeb = TimeSerial(HeureDeb, MinuteDeb, 0)
'Calcul de la tranche horaire Pause Dejeuner
var1 = (HeureHMFin - HeureHMDeb) * 24
EntPausedej = Int(var1)
PartDecim = (var1 - EntPausedej) * 60
'Affichage de la durée de pause déjeuner
Pausedej = TimeSerial(EntPausedej, PartDecim, O)
TxtDureePause = Pausedej
Else
mes = MsgBox("La pause déjeuner n'a pas été prise dans le créneau horaire. Pour plus de détails, vérifiez les enregistrements de pointage", vbInformation, "RH")
End If
Next i
Case 6
While test <> "OK" And RstPointage.EOF = False
'For i = 1 To 5
RstPointage.Move (1)
HeureDeb = RstPointage!poin_heure
MinuteDeb = RstPointage!Poin_minute
HeureHMDeb = HeureDeb & ":" & MinuteDeb
MsgBox (HeureHMDeb)
RstPointage.MoveNext
'RstPointage.MoveFirst
HeureFin = RstPointage!poin_heure
MinuteFin = RstPointage!Poin_minute
HeureHMFin = HeureFin & ":" & MinuteFin
MsgBox (HeureHMFin)
RstPointage.MoveNext
If HeureHMDeb >= "12" And HeureHMFin <= "14" Then
'If HeureHMDeb >= "1200" And HeureHMDeb <= "1400" And HeureHMFin >= "1200" And HeureHMFin <= "1500" Then 'Assembler HH:MM
' Absence = 0
test = "OK"
'Calcul de l'heure de dej
HeureHMFin = TimeSerial(HeureFin, MinuteFin, 0)
HeureHMDeb = TimeSerial(HeureDeb, MinuteDeb, 0)
'Calcul de la tranche horaire Pause Dejeuner
var1 = (HeureHMFin - HeureHMDeb) * 24
EntPausedej = Int(var1)
PartDecim = (var1 - EntPausedej) * 60
'Affichage de la durée de pause déjeuner
Pausedej = TimeSerial(EntPausedej, PartDecim, O)
TxtDureePause = Pausedej
Else
mes = MsgBox("La pause déjeuner n'a pas été prise dans le créneau horaire. Pour plus de détails, vérifiez les enregistrements de pointage", vbInformation, "RH")
i = i + 1
End If
Wend
req = "SELECT EST_ABSENT.DateAbsence, Motif, IDsalarie, EST_ABSENT.IDSalarie FROM EST_ABSENT WHERE EST_ABSENT.DateAbsence= #" & vardate & "# AND EST_ABSENT.IDsalarie = '" & RstPersonne!code & "' "
'MsgBox (RstPersonne!code)
Set RstAbsence = Bds.OpenRecordset(req)
If RstAbsence.RecordCount > 0 Then 'Le salarié a une absence justifiée ?
mes = MsgBox("Le salarié " & LstSalarie.Column(1) & " est absenté en date du " & vardate & " pour le motif suivant : " & RstAbsence!Motif & ".", vbInformation, "RH")
Else
mes = MsgBox("Le salarié " & LstSalarie.Column(1) & " ne dispose d'aucune absence justifiée !", vbCritical, "RH")
End If
End Select
Else
MsgBox ("Aucun enregistrement réalisé...")
End If
RstPersonne.MoveNext
Wend
End If
Set RstPointage = Nothing
Set RstPersonne = Nothing
Set RstAbsence = Nothing
End Sub |
Partager