openaccess/test/source/modules/TraitementDonnees.bas

Option Compare Database

Public Function suppression(Tbl As String, ByVal CodeAgent As String, ByVal moisRH As Integer, ByVal anneeRH As Integer, avertissement As Integer)
'ATTENTION: fonction à utiliser avec précaution (ajouter éventuellement une distinction entre valide et invalide)

If avertissement = 0 Then DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE " & Tbl & ".*, " & Tbl & ".CodeAgent, " & Tbl & ".MoisRH, " & Tbl & ".AnneeRH " & _
             "FROM " & Tbl & " " & _
             "WHERE (((" & Tbl & ".CodeAgent)='" & CodeAgent & "') AND ((" & Tbl & ".MoisRH)=" & moisRH & ") AND ((" & Tbl & ".AnneeRH)=" & anneeRH & "));"
DoCmd.SetWarnings True

End Function

Public Function invalidation(Tbl As String, ByVal CodeAgent As String, ByVal moisRH As Integer, ByVal anneeRH As Integer, avertissement As Integer)


If avertissement = 0 Then DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE " & Tbl & " SET " & Tbl & ".Valide = False " & _
             "WHERE (((" & Tbl & ".CodeAgent)='" & CodeAgent & "') AND ((" & Tbl & ".MoisRH)=" & moisRH & ") AND ((" & Tbl & ".AnneeRH)=" & anneeRH & "));"
DoCmd.SetWarnings True

End Function



Public Function CumulHS(CodeAgent As String, DateRH As Date) '!!! Obsolete
Dim moisRH, anneeRH As Integer
Dim rs As DAO.Recordset
Dim TotalHS, diff As Double

'total des heures sup du mois (tout compris) jusqu'à la date indiquée
moisRH = Month(DateRH)
anneeRH = Year(DateRH)
TotalHS = 0

Set rs = CurrentDb.OpenRecordset("SELECT tbl_ImportRH.CodeAgent, tbl_ImportRH.DateRH, Month([dateRH]) AS moisRH, Year([dateRH]) AS anneeRH, tbl_ImportRH.HeureSup1, tbl_ImportRH.HeureSup2, tbl_ImportRH.HeureSupDimanche " & _
                                 "FROM tbl_ImportRH " & _
                                 "WHERE (((tbl_ImportRH.codeagent) = '" & CodeAgent & "') And ((Month([dateRH])) = " & moisRH & ") And ((Year([dateRH])) = " & anneeRH & ")) " & _
                                 "ORDER BY tbl_ImportRH.DateRH;")

rs.MoveFirst
Do Until rs.EOF = True
  If rs![DateRH] > DateRH Then Exit Do
  
  TotalHS = TotalHS + rs![HeureSup1] + rs![HeureSup2] + rs![HeureSupDimanche]

  If rs![DateRH] = DateRH Then Exit Do
rs.MoveNext
Loop

CumulHS = TotalHS

End Function

Sub test()
MsgBox Itineraire("r_FormDep_1", "Localisation", "T32", 2, 12, 2013)
End Sub

Public Function Itineraire(Requete, Source, ByVal CodeAgent, ByVal JourRH As Integer, ByVal moisRH As Integer, ByVal anneeRH As Integer)
Dim rst As DAO.Recordset
Dim critere, strSQL As String

Itineraire = ""
critere = "[CodeAgent]='" & CodeAgent & "' AND [JourRH]=" & JourRH & " AND [MoisRH]=" & moisRH & " AND [AnneeRH]=" & anneeRH

strSQL = "SELECT " & Requete & ".* FROM " & Requete & " WHERE " & critere & ";"

If DCount(Source, Requete, critere) = 0 Then
 Exit Function
End If

Set rst = CurrentDb.OpenRecordset(strSQL)

rst.MoveFirst
Itineraire = Nz(rst(Source), "")

If rst.RecordCount > 1 Then
 rst.MoveNext
 Do Until rst.EOF
    Itineraire = Itineraire & "-" & Nz(rst(Source), "")
    rst.MoveNext
 Loop
End If

Set rst = Nothing

End Function

Public Function HSinf14(H1 As Double, CodeAgent As String, DateRH As Date)
Dim moisRH, anneeRH As Integer
Dim rs As DAO.Recordset
Dim TotalHS As Double

moisRH = Month(DateRH)
anneeRH = Year(DateRH)
JourRH = Day(DateRH)
TotalHS = 0

If JourRH = 1 Then
  If H1 > 14 Then
   HSinf14 = 14
  Else
   HSinf14 = H1
  End If
Else

  'calcul du total des heures sup jusqu'à cette date
  Set rs = CurrentDb.OpenRecordset("SELECT r_HeuresSup.CodeAgent, r_HeuresSup.JourRH, r_HeuresSup.moisRH, r_HeuresSup.anneeRH, r_HeuresSup.HS, r_HeuresSup.HSNuit, r_HeuresSup.HeureSupDimanche " & _
                                 "FROM r_HeuresSup " & _
                                 "WHERE ((r_HeuresSup.codeagent) = '" & CodeAgent & "') And ((r_HeuresSup.moisRH) = " & moisRH & ") And ((r_HeuresSup.anneeRH) = " & anneeRH & ") " & _
                                 "ORDER BY r_HeuresSup.JourRH;")
  rs.MoveFirst
  Do Until rs.EOF = True
    If rs![JourRH] > JourRH - 1 Then Exit Do
    TotalHS = TotalHS + Nz(rs![HS], 0) + Nz(rs![HSNuit], 0) + Nz(rs![HeureSupDimanche], 0)
    If rs![JourRH] = JourRH - 1 Then Exit Do
  rs.MoveNext
  Loop
  Debug.Print JourRH, TotalHS
  If TotalHS > 14 Then
   HSinf14 = 0
  ElseIf TotalHS + H1 > 14 Then
   HSinf14 = 14 - TotalHS
  Else
   HSinf14 = H1
  End If
End If


End Function

Public Function HSsup14(H1 As Double, CodeAgent As String, DateRH As Date)
Dim moisRH, anneeRH As Integer
Dim rs As DAO.Recordset
Dim TotalHS As Double

moisRH = Month(DateRH)
anneeRH = Year(DateRH)
JourRH = Day(DateRH)
TotalHS = 0


If JourRH = 1 Then
  If H1 > 14 Then
   HSsup14 = H1 - 14
  Else
   HSsup14 = 0
  End If
Else

  'calcul du total des heures sup jusqu'à cette date
  Set rs = CurrentDb.OpenRecordset("SELECT r_HeuresSup.CodeAgent, r_HeuresSup.JourRH, r_HeuresSup.moisRH, r_HeuresSup.anneeRH, r_HeuresSup.HS, r_HeuresSup.HSNuit, r_HeuresSup.HeureSupDimanche " & _
                                 "FROM r_HeuresSup " & _
                                 "WHERE ((r_HeuresSup.codeagent) = '" & CodeAgent & "') And ((r_HeuresSup.moisRH) = " & moisRH & ") And ((r_HeuresSup.anneeRH) = " & anneeRH & ") " & _
                                 "ORDER BY r_HeuresSup.JourRH;")
  rs.MoveFirst
  Do Until rs.EOF = True
    If rs![JourRH] > JourRH - 1 Then Exit Do
    TotalHS = TotalHS + Nz(rs![HS], 0) + Nz(rs![HSNuit], 0) + Nz(rs![HeureSupDimanche], 0)
    If rs![JourRH] = JourRH - 1 Then Exit Do
  rs.MoveNext
  Loop

  If TotalHS > 14 Then
   HSsup14 = H1
  ElseIf TotalHS + H1 > 14 Then
   HSsup14 = (TotalHS + H1) - 14
  Else
   HSsup14 = 0
  End If
End If


End Function

Public Function Bareme(NomBareme As String, Valeur As Double, ByVal moisRH As Integer, ByVal anneeRH As Integer)
Dim rs As DAO.Recordset
Dim PeriodeValidite As Integer


PeriodeValidite = PeriodeBareme(NomBareme, moisRH, anneeRH)

Set rs = CurrentDb.OpenRecordset("SELECT * FROM tbl_baremes WHERE [NomBareme]='" & NomBareme & "' AND [PeriodeValidite]=" & PeriodeValidite & ";")
If rs.RecordCount = 0 Then
Bareme = 0
Exit Function
End If
rs.MoveFirst

If Nz(rs![BorneInf], "") = "" And Nz(rs![BorneSup], "") = "" Then
 Bareme = rs![Valeur]
 Exit Function
End If

Do Until rs.EOF = True
 If Valeur >= rs![BorneInf] And Valeur <= rs![BorneSup] Then
  Bareme = rs![Valeur]
  Exit Function
 End If
rs.MoveNext
Loop

Bareme = -1

End Function

Public Function AnalyseDonnees(IDSuivi As Double, ByVal CodeAgent As String, ByVal moisRH As Integer, ByVal anneeRH As Integer, ByVal avertissement As Integer)

Dim critere, sql As String
Dim JourRH As Integer
Dim rsS, rsC As Recordset 'recordset source, recordset cible

'ATTENTION: la requête d'insertion dans tbl_formHS utilise des résultat de la table tbl_FormDep. Celle-ci doit donc impérativement être remplie en premier.

If CodeAgent = "" Or Not anneeRH > 2000 Or Not moisRH <= 12 Or Not moisRH > 0 Then
 AnalyseDonnees = -1
 Exit Function
End If

Call AfficherMsgProgression("Traitement", "Analyse des données de " & CodeAgent & " (" & moisRH & "/" & anneeRH & ")")
Call MajMsgProgression(1, 5)
DoEvents

'CREATION FORM DEPLACEMENTS
'vérification
If VerifEtat("tbl_FormDep", CodeAgent, moisRH, anneeRH, avertissement) = -1 Then Exit Function '4e arg=0 pour pas d'avertissement avant MAJ/Suppr

 'ajout des lignes à tbl_formDep

 critere = "[CodeAgent]='" & CodeAgent & "' AND [MoisRH]=" & moisRH & " AND [AnneeRH]=" & anneeRH

 sql = "INSERT INTO tbl_FormDep ( AnneeRH, MoisRH, CodeAgent, JourRH, Distance1_perso, Distance2_perso, Distance2_service, Itineraire, HeuresDep, HeuresDepNuit, " & _
     "Repas, IDSuivi, Valide, CreePar, CreeLe ) " & _
     "SELECT r_FormDep2.AnneeRH, r_FormDep2.MoisRH, r_FormDep2.CodeAgent, r_FormDep2.JourRH, r_FormDep2.SommeDeDistance1_perso AS Distance1_perso, " & _
     "r_FormDep2.SommeDeDistance2_perso AS Distance2_perso, r_FormDep2.SommeDeDistance2_service AS Distance2_service, r_FormDep2.Itineraire, " & _
     "r_FormDep2.SommeDeHeuresDep AS HeuresDep, r_FormDep2.SommeDeHeuresDepNuit AS HeuresDepNuit, r_FormDep2.SommeDeRepas AS Repas, " & _
     "" & IDSuivi & " AS Expr1, True AS Expr3, '" & Environ("username") & "' AS Expr4, Now() AS Expr5 " & _
     "FROM r_FormDep2 " & _
     "WHERE " & critere & ";"

 'Debug.Print sql
 If avertissement = 0 Then DoCmd.SetWarnings False
 DoCmd.RunSQL sql
 DoCmd.SetWarnings True
 
 Call MajMsgProgression(3, 5)
'CREATION FORM HEURES SUP
'vérification
If VerifEtat("tbl_FormHS", CodeAgent, moisRH, anneeRH, avertissement) = -1 Then Exit Function '4e arg=0 pour pas d'avertissement avant MAJ/Suppr

 'ajout des lignes à tbl_formHS

 critere = "[CodeAgent]='" & CodeAgent & "' AND [MoisRH]=" & moisRH & " AND [AnneeRH]=" & anneeRH

 sql = "INSERT INTO tbl_FormHS ( CodeAgent, JourRH, MoisRH, AnneeRH, HeureSup1, HeuresDep, HeuresDepNuit, " & _
       "[HeureSup1<=14], [HeureSup1>14], HeureSupNuit, HeureSupDim, HS_VHCanal, HS_Chantier, CreePar, CreeLe, Valide, IDSuivi ) " & _
       "SELECT r_HeuresSup2.CodeAgent, r_HeuresSup2.JourRH, r_HeuresSup2.MoisRH, r_HeuresSup2.AnneeRH, " & _
       "r_HeuresSup2.HeureSup1, r_HeuresSup2.HeuresDep, r_HeuresSup2.HeuresDepNuit, " & _
       "r_HeuresSup2.[H<14], r_HeuresSup2.[H>14], r_HeuresSup2.HSNuit, r_HeuresSup2.HeureSupDimanche, HS_VHCanal, HS_Chantier, " & _
       "'" & Environ("Username") & "' AS Expr2, Now() AS Expr3, True AS Expr4, " & IDSuivi & " As Expr5 " & _
       "FROM r_HeuresSup2 " & _
       "WHERE " & critere & " " & _
       "ORDER BY [JourRH];"
       
 'Debug.Print sql
 If avertissement = 0 Then DoCmd.SetWarnings False
 DoCmd.RunSQL sql
 DoCmd.SetWarnings True

Call MajMsgProgression(4, 5)
'AnalyseDonnees = Nz(VerifCompteLignes(CodeAgent, moisRH, anneeRH), -1)
Call MajMsgProgression(5, 5)
'résultat: -1 -> erreur inconnue ou mauvais paramètres d'entrée
          ' 0 -> erreur dans le décompte des lignes
           '1-> parait être bon

End Function

Public Function TypeAuto(CodeAgent As String, moisRH As Integer, anneeRH As Integer)
Dim critere As String
Dim DateRH, validite As Date
Dim puissance As Double
'dateRH = CDate("#15/" & moisRH & "/" & anneeRH & "#")
'validite = LigneValide("tbl_Agents", dateRH, "[CodeAgent]='" & CodeAgent & "'")

critere = "[CodeAgent]='" & CodeAgent & "'"

If DLookup("TypeVehicule", "r_Agents", critere) = 1 Then
 puissance = Nz(DLookup("PuissanceFiscVP", "r_Agents", critere), 1)
 TypeAuto = Bareme("Puissance Fiscale", puissance, moisRH, anneeRH)
Else
 TypeAuto = ""
End If
End Function

Public Function DistanceAnnee(CodeAgent As String, moisRH As Integer, anneeRH As Integer)
'cette fonction renvoie le nombre de kilomètres parcourus par l'agent depuis le début de l'année
'jusqu'au mois indiqué NON-COMPRIS
'Cette fonction est utilisée dans le calcul des frais kilométriques
'Des kilomètres additionnels peuvent être ajoutés manuellement lors de la création d'un nouvel agent (cf. tbl_KmSuppl)

Dim rs As DAO.Recordset
Dim Distance As Double
Dim KmSuppl As Double

If CodeAgent = "" Or Not anneeRH > 2000 Or Not moisRH <= 12 Or Not moisRH > 0 Then
 DistanceAnnee = 0
 MsgBox "Erreur Paramètres dans l'appel de la fonction DistanceAnnee"
 Exit Function
End If

DistanceAnnee = 0

'recherche d'éventuels km supplémentaires
KmSuppl = Nz(DSum("KmSuppl", "tbl_KmSuppl", "[CodeAgent]='" & CodeAgent & "' AND [AnneeRH]=" & anneeRH), 0)

DistanceAnnee = KmSuppl

If moisRH = 1 Then 'cas du mois de janvier
 Exit Function
End If

Set rs = CurrentDb.OpenRecordset("SELECT tbl_FormDep.CodeAgent, tbl_FormDep.JourRH, tbl_FormDep.MoisRH, tbl_FormDep.AnneeRH, tbl_FormDep.Distance2_perso, tbl_FormDep.Distance1_perso, [Distance2_perso]+[Distance1_perso] AS DistancePerso " & _
                                 "FROM tbl_FormDep WHERE (((tbl_FormDep.CodeAgent)='" & CodeAgent & "') AND ((tbl_FormDep.MoisRH)<" & moisRH & ") AND ((tbl_FormDep.AnneeRH)=" & anneeRH & "));")
Distance = 0
If rs.RecordCount > 0 Then
 rs.MoveFirst
 Do Until rs.EOF = True
  Distance = Distance + rs![DistancePerso]
  rs.MoveNext
 Loop
End If
DistanceAnnee = DistanceAnnee + Distance

End Function

Public Function NvellePeriode(ByVal table As String, ByVal Champ1_valeur As String, ByVal DateInf As Date)
'cette fonction permet la création d'une nouvelle periode de validité dans la table tbl_Periodebareme ou tbl_PeriodeAgent
'le champ1 correspond selon la table au code de l'agent ou au nom du bareme
'la fonction attribue une date de fin à l'ancienne periode, créé la nouvelle période, et lui attribue un nouveau code et une date de début

Dim rs As DAO.Recordset
Dim champ1_nom, sql, msg As String
Dim conflit, avertissement, CodePeriode, AnciennePeriode As Integer
Dim dateconflit As Date

Set rs = CurrentDb.OpenRecordset(table)
champ1_nom = rs.Fields(0).Name

avertissement = parametre("avertSQL")
conflit = CtrlValidite(table, Champ1_valeur, DateInf)

CodePeriode = Nz(DMax("[CodePeriode]", table, "[" & champ1_nom & "]='" & Champ1_valeur & "'"), 0) + 1
'la fonction CtrlValidite renvoie le code de la période avec laquelle la nouvelle date entre en conflit
'si ce code est positif, la nouvelle date est comprise dans la période en question
's'il est négatif, elle y est antérieure et la date de fin sera automatiquement remplie


If conflit <> 0 Then
 Select Case conflit
  Case Is < 0
   dateconflit = DLookup("[DateInf]", table, "[" & champ1_nom & "]='" & Champ1_valeur & "' AND [CodePeriode]=" & -1 * conflit)
   If IsNull(dateconflit) Then
     msg = "Erreur: conflit avec la periode " & -1 * conflit & ". Veuillez vérifier la date de début de cette période ou contacter un administrateur."
     NvellePeriode = 0
     Exit Function
   Else
     msg = "ATTENTION: La date choisie est antérieure à une période existante (période " & -1 * conflit & ") dont la date de début est " & _
           dateconflit & "." & vbNewLine & "Si vous continuez, la date de fin de la période en création sera automatiquement enregistrée comme étant " & dateconflit - 1 & "."
     If MsgBox(msg, vbYesNo) = vbNo Then
      NvellePeriode = 0
      Exit Function
     End If
   End If
  Case Is > 0
   msg = "ATTENTION: La date choisie est comprise dans une période existante (période " & conflit & "). " & vbNewLine & "Veuillez choisir une autre date ou contacter un administrateur."
   MsgBox msg
   NvellePeriode = 0
   Exit Function
 End Select
End If

 msg = "Une nouvelle période va être créée qui prendra effet à compter du " & DateInf
 If MsgBox(msg, vbYesNo) = vbNo Then
  NvellePeriode = 0
  Exit Function
 End If

If avertissement = 0 Then DoCmd.SetWarnings False

Select Case conflit

 Case 0
  AnciennePeriode = Nz(DLookup("[CodePeriode]", table, "[" & champ1_nom & "]='" & Champ1_valeur & "' AND [DateSup] is null"), 0)
  'fermeture de l'ancienne periode
  If AnciennePeriode <> 0 Then
   sql = "UPDATE " & table & " SET " & table & ".DateSup = Format(#" & CDate(DateInf) - 1 & "#,'mm/dd/yyyy') " & _
         "WHERE (((" & table & "." & champ1_nom & ")='" & Champ1_valeur & "') AND ((" & table & ".CodePeriode)=" & AnciennePeriode & "));"
   DoCmd.RunSQL sql
  End If
  'creation de la nouvelle periode

  rs.AddNew
  rs(champ1_nom) = Champ1_valeur
  rs![DateInf] = CDate(DateInf)
  rs![CodePeriode] = CodePeriode
  rs.Update

 Case Is < 0

  'creation de la nouvelle periode avec pour date de fin la veille de la période qui suit

  rs.AddNew
  rs(champ1_nom) = Champ1_valeur
  rs![DateInf] = DateInf
  rs![DateSup] = dateconflit - 1
  rs![CodePeriode] = CodePeriode
  rs.Update
 
 
End Select
DoCmd.SetWarnings True

NvellePeriode = CodePeriode

End Function


Public Function EtatSuivi(CodeAgent As String, moisRH As Integer, anneeRH As Integer)
'renvoie l'état des données depuis tbl_SuiviRH
Dim critere As String
If CodeAgent <> "" And anneeRH > 2000 And moisRH <= 12 And moisRH > 0 Then
 critere = "[CodeAgent]='" & CodeAgent & "' AND [MoisRH]=" & moisRH & " AND [AnneeRH]=" & anneeRH
 If Nz(DLookup("[Edite]", "tbl_SuiviRH", critere), False) = False Then
  EtatSuivi = Nz(DLookup("[Etat]", "tbl_SuiviRH", critere), "Pas de données")
 Else
  EtatSuivi = "Edité"
 End If
Else
 EtatSuivi = "erreur"
End If
End Function