vitesse d'exécution...

Raymond [mvp]

14/04/2005 à 20:08

Bonsoir Joël.

elle est longue ta boucle ? si non affiche la ici.

est-ce la boucle ou la requête qui est longue ? quel est l'ordre d'idée du
temps nécessaire ?

--
@+
Raymond Access MVP
http://OfficeSystem.Access.free.fr/
http://OfficeSystem.Access.free.fr/runtime/
http://users.skynet.be/mpfa/ pour débuter sur le forum

"Joël GARBE" a écrit dans le message de news:
425eb091$0$3120$

Bonsoir,

Je cherche à gagner du temps dans des procédures où il y a 3 niveaux de
boucles inbriquées.

La procédure fonctionne correctement mais est très lente...

A l'intérieur de chaque boucle, j'effectue une requête me permettant de
récupérer des information sur l'élément de la boucle.

La durée d'exécution est très lente et je cherche un moyen de diminuer
cette durée.

Quel peut être ce moyen ?

Une recherche à la place de la requête .? ou autre chose ?

Toutes propositions sera la bienvenue !!!

Vous en remerciant par avance,
--

Bien cordialement,

Joël GARBE
www.joelgarbe.fr

Joël GARBE

14/04/2005 à 20:22

Merci Raymond,

Puisque tu insistes, on peux tenter le coup (je ne risque rien !)
Sur mon poste (avec 1 année soit 12 mois d'étude et 500 employés : environ 5
minutes maxi)
Sur un autre poste et 24 mois d'étude ... 2 heures !!!!!!!!!!!!!!
Pour chaque employé, pour chaque prime, je dois créer des périodes
(renseigner les primes de chaque employé dans chaque période)

sachant que ma base est structurée :
Table Employes
Table SuiviSalarie (Listant toutes les primes de toutes les période de
chaque employé, soit autant d'enregistrement par employé et par période
qu'il y a de primes)
Table SuiviSalarieAnnexe (Listant les informations de base de chaque employé
pour une période donnée : Niveau, Service, Taux d'emploi, etc... 1 enr par
employé et par période)
Table Periode ... Listant les différentes périodes (Réel (1) Budget (2)
Forecast (3)
'==================================================== Private Sub CalculTout()
'Centre névralgique des Budget et Forecast
'Rechercher les enregistrements à modifier dans la table
'SuiviSalarie et SuiviSalarieAnnexe
'Commencer par passer en revue tous les enregistrements du formulaire
Set dbs = CurrentDb

Set rst = dbs.OpenRecordset("Constantes", dbOpenTable)
TxCP = rst.Fields("TauxChargePatronale")

sql = "SELECT Periodes.* " & _
"FROM Periodes " & _
"WHERE (((Periodes.Reel) = " & IIf(Forms("FormMenuPrinc").CACType, 2, 3)
& ")) " & _
"ORDER BY Periodes.Annee, Periodes.Mois;"

Set rstPP = dbs.OpenRecordset(sql, dbOpenDynaset)

If rstPP.RecordCount = 0 Then
AfficheMessage "Avant de lancer le calcul, il faut générer les périodes" &
Chr(10) & _
"L'opération est annulée"
GoTo FinProc
End If

'déterminer le premier mois et la première année du Budget / Forecast
PremMoisBF = rstPP.Fields("Mois")
PremAnneeBF = rstPP.Fields("Annee")

'Mais avant : Les constantes...
Set rstE = dbs.OpenRecordset("Constantes", dbOpenTable)
If rstE.RecordCount = 0 Then
AfficheMessage "La base de donnée ne contient aucune Constante !!!" &
Chr(10) & _
"L'opération est annulée"
GoTo FinProc
End If
rstE.MoveFirst
MaxAnc = rstE.Fields("MaxAnciennete")
NivRef = rstE.Fields("NivAnciennete")
MontantAbond = rstE.Fields("Abondement")
MontantInter = rstE.Fields("Interessement")
MontantPart = rstE.Fields("Participation")
MontantPres = rstE.Fields("PrimePresenteisme")

Bonus1 = rstE.Fields("Bonus1")
Bonus2 = rstE.Fields("Bonus2")

'On va passer en revue tous les employés...
'Tous ? pour les embauches vérifier si embauche prévue au budget/Forecast
Set rstE = dbs.OpenRecordset("Employes", dbOpenTable)
If rstE.RecordCount = 0 Then
AfficheMessage "La base de donnée ne contient aucun employé !!!" & Chr(10)
& _
"L'opération est annulée"
GoTo FinProc
End If
rstE.MoveLast
NbEmp = rstE.RecordCount

Set rstR = dbs.OpenRecordset("RqReelComplet", dbOpenDynaset)
If rstR.RecordCount > 0 Then
rstR.MoveLast
NbEnrReel = rstR.RecordCount
Else
AfficheMessage "Pour élaborer le budget ou le forecast, il faut avoir
importé au moins un mois complet" & Chr(10) & _
"C'est à dire les 3 fichiers : effectif, base/ancienneté et Primes" &
Chr(10) & Chr(10) & _
"L'opération est annulée"
GoTo FinProc
End If

'si on commençait pas supprimer toutes les périodes du
'SuiviSalarie et SuiviSalarieAnnexe
'Euh... peut-être pas ici ;-)

'================================================================================ 'étude : modifier si la période existe déjà !

sql = "DELETE SuiviSalarie.* " & _
"FROM Periodes INNER JOIN SuiviSalarie ON Periodes.N°Periode =
SuiviSalarie.Periode " & _
"WHERE (((Periodes.Reel)= " & IIf(Forms("FormMenuPrinc").CACType, 2, 3) &
"));"

DoCmd.RunSQL sql
'================================================================================== Set rstP = dbs.OpenRecordset("SuiviSalarie", dbOpenTable)
rstP.MoveLast

'ici le début de la barre de progression
NbCycle = NbEmp
Pbar.Ouvrir
Forms("frmProgressBis").Caption = "MAJ Employé : " & rstE.Fields("Nom") & "
" & rstE.Fields("PreNom")

CompteurBar = NbCycle / 100
RefCompteur = 0

Set rstSuiviS = dbs.OpenRecordset("SuiviSalarie", dbOpenTable)
Set rstSuiviAnS = dbs.OpenRecordset("SuiviSalarieAnnexe", dbOpenTable)

rstE.MoveFirst
'====================================== Do

Forms("frmProgressBis").Caption = "MAJ Employé : " & rstE.Fields("Nom") & "
" & rstE.Fields("Prenom")

RefCompteur = RefCompteur + 1
If RefCompteur = CompteurBar Then
RefCompteur = 0
Pbar.Avancer 1
End If

'Employé par employé
NumEmp = rstE.Fields("N°Salarie")
On Error Resume Next
MoisEmb = Month(rstE.Fields("DateEmbauche"))
AnneeEmb = Year(rstE.Fields("DateEmbauche"))
On Error GoTo 0

'déterminer les informations annexes de base concernant l'employé :
sql = "SELECT SuiviSalarieAnnexe.Periode, Niveaux.Niveau,
SuiviSalarieAnnexe.Salarie, Niveaux.N°Niveau, SuiviSalarieAnnexe.CB,
SuiviSalarieAnnexe.Statut, SuiviSalarieAnnexe.Taux,
SuiviSalarieAnnexe.TypeContrat, Periodes.Reel " & _
"FROM Periodes INNER JOIN (Niveaux INNER JOIN SuiviSalarieAnnexe ON
Niveaux.N°Niveau = SuiviSalarieAnnexe.Niveau) ON Periodes.N°Periode =
SuiviSalarieAnnexe.Periode " & _
"WHERE (((SuiviSalarieAnnexe.Salarie) = " & NumEmp & ") And
((Periodes.Reel) = 1)) " & _
"ORDER BY SuiviSalarieAnnexe.Periode DESC;"

Set rstEmpAn = dbs.OpenRecordset(sql, dbOpenDynaset)

'=====================================================
KelTaux = 1
On Error Resume Next
'Par employé et par période...
NivEmp = rstEmpAn.Fields("Niveau")
NumNiv = rstEmpAn.Fields("N°Niveau")
KelNiv = CInt(Left(rstEmpAn.Fields("Niveau"), 1))
KelCB = rstEmpAn.Fields("CB")
KelStatut = rstEmpAn.Fields("Statut")
KelTaux = rstEmpAn.Fields("Taux")
KelContrat = rstEmpAn.Fields("TypeContrat")

On Error GoTo 0
'=====================================================
'Prime par prime de l'employé des fichiers réels
sql = "SELECT Primes.N°Prime, SuiviSalarie.Salarie, Periodes.Reel " & _
"FROM Periodes INNER JOIN (Primes INNER JOIN SuiviSalarie ON
Primes.N°Prime = SuiviSalarie.Prime) ON Periodes.N°Periode =
SuiviSalarie.Periode " & _
"GROUP BY Primes.N°Prime, SuiviSalarie.Salarie, Periodes.Reel " & _
"HAVING (((SuiviSalarie.Salarie)=" & NumEmp & " AND
((Periodes.Reel)=1)));"

Set rstP = dbs.OpenRecordset(sql, dbOpenDynaset)
If rstP.RecordCount > 0 Then 'Employé réel sinon embauche prévue
rstP.MoveFirst
'============================================= CompteurPrime = 0

Do
CompteurPrime = CompteurPrime + 1
'Prime par prime
NumP = rstP.Fields("N°Prime")
'CodeP = rstP.Fields("CodePrime")
Dim rstPr As DAO.Recordset
sql = "SELECT Primes.* FROM Primes WHERE Primes.N°Prime = " & NumP &
";"
Set rstPr = dbs.OpenRecordset(sql, dbOpenDynaset)
rstPr.MoveFirst
CodeP = rstPr.Fields("CodePrime")
rstPr.Close

Set rstPr = Nothing

sql = "SELECT Primes.N°Prime, SuiviSalarie.Salarie,
SuiviSalarie.Periode, SuiviSalarie.Montant, Periodes.Annee, Periodes.Mois "
& _
"FROM Periodes INNER JOIN (Primes INNER JOIN SuiviSalarie ON
Primes.N°Prime = SuiviSalarie.Prime) ON Periodes.N°Periode =
SuiviSalarie.Periode " & _
"WHERE (((Primes.N°Prime)=" & NumP & ") AND
((SuiviSalarie.Salarie)=" & NumEmp & ")) " & _
"ORDER BY Periodes.Annee DESC , Periodes.Mois DESC;"
'Commencer par déterminer les montants de référence pour chacune des
primes de l'employé
'La moyenne des 5 périodes précédentes !
Set rstPRE = dbs.OpenRecordset(sql, dbOpenDynaset)
rstPRE.MoveFirst
i = 0
MontantRef = 0
Do
MontantRef = rstPRE.Fields("Montant")
If (rstPRE.Fields("Mois") <= PremMoisBF And rstPRE.Fields("Annee") =
PremAnneeBF) Or rstPRE.Fields("Annee") < PremAnneeBF Then
ReDim Preserve MontantPEmp(i)
MontantPEmp(i) = rstPRE.Fields("Montant")
i = i + 1
End If
rstPRE.MoveNext
Loop Until rstPRE.EOF Or i = 5

If i > 0 Then
'il y a eu de période réelle antérieure à la première période du
budget/Forecast trouvée...
MontantRef = 0
'déterminer le montant de référence pour cette prime de cet
employé...
For i = LBound(MontantPEmp()) To UBound(MontantPEmp())
MontantRef = MontantRef + MontantPEmp(i)
Next
MontantRef = MontantRef / (UBound(MontantPEmp()) + 1)
End If
'Injecter ce montant dans le budget / Forecast...
'Attention aux augmentations...
'Déterminer déjà le niveau de l'employé

'Passer maintenant en revue toutes les périodes du formulaire...

rstPP.MoveFirst
CompteurPer = 0
Do
CompteurPer = CompteurPer + 1
'La période existe, c'est obligatoire...
KelPer = rstPP.Fields("N°Periode")

KelMois = rstPP.Fields("Mois")
KelAnnee = rstPP.Fields("Annee")

Select Case KelNiv
Case Is <= 3
If Left(NivEmp, 2) <> "10" Then
MontantRef = MontantRef * (1 + rstPP.Fields("AugmenT1"))
End If
Case 4 To 6
MontantRef = MontantRef * (1 + rstPP.Fields("AugmenT2"))
Case Else
MontantRef = MontantRef * (1 + rstPP.Fields("AugmenT3"))
End Select

If NumP = 2 Then 'Prime d'ancienneté
If KelNiv <= NivRef And Right(NivEmp, 2) <> "6B" And Left(NivEmp,
2) <> "10" Then
sql = "SELECT Primes.N°Prime, SuiviSalarie.Salarie,
Periodes.Reel, SuiviSalarie.Montant, Periodes.N°Periode, Primes.CP " & _
"FROM Periodes INNER JOIN (Primes INNER JOIN SuiviSalarie ON
Primes.N°Prime = SuiviSalarie.Prime) ON Periodes.N°Periode =
SuiviSalarie.Periode " & _
"WHERE (SuiviSalarie.Salarie=" & NumEmp & ") AND
(Periodes.N°Periode=" & KelPer & ") AND (Periodes.Reel=" &
IIf(Forms("FormMenuPrinc").CACType, 2, 3) & ") AND N°Prime=1;"
Dim rsBaseEmp As DAO.Recordset

Set rsBaseEmp = dbs.OpenRecordset(sql, dbOpenDynaset)
rsBaseEmp.MoveFirst
BaseEmp = rsBaseEmp.Fields("Montant")
MontantRef = BaseEmp * (IIf(MaxAnc / 100 > Int(((KelAnnee -
AnneeEmb) * 12 + KelMois - MoisEmb - 1) / 12) / 100, Int(((KelAnnee -
AnneeEmb) * 12 + KelMois - MoisEmb - 1) / 12) / 100, MaxAnc / 100))
End If

'Gratification d'ancienneté 'annulé sur demande de DDL !
GoTo PassGrat
If (KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 120 Then
MontantRef = (MontantRef + BaseEmp) * 0.5 + MontantRef

End If

If (KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 180 Then
MontantRef = (MontantRef + BaseEmp) * 0.75 + MontantRef

End If

If (KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 240 Or _
(KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 300 Or _
(KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 360 Then
MontantRef = (MontantRef + BaseEmp) + MontantRef

End If

If (KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 420 Or _
(KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 480 Then
MontantRef = (MontantRef + BaseEmp) * 2 + MontantRef

End If
PassGrat:

End If
If CodeP = "2042" Or CodeP = "2044" Or _
CodeP = "2048" Or CodeP = "2058" Or CodeP = "9BAP" Or _
CodeP = "/101" Then
Else
Dim rsCP As DAO.Recordset
Set rsCP = dbs.OpenRecordset("SELECT Primes.* FROM Primes WHERE
Primes.N°Prime = " & NumP & ";")
rsCP.MoveFirst

CPOK = rsCP.Fields("CP")

If NumP = 3 Then 'Abondement
MontantRef = MontantAbond
End If
If NumP = 4 Then 'Intéressement
MontantRef = MontantInter
End If
If NumP = 5 Then 'Participation
MontantRef = MontantPart
End If
If NumP = 6 Then 'Présentéïsme
MontantRef = MontantPres
End If
If NumP = 7 Then 'Bonus Or CodeP = "9106"
'tous les mois !
'Niveau 7 et 8 : 10% du salaire annuel
If KelNiv = 7 Or KelNiv = 8 Then
MontantRef = BaseEmp * 13 * 0.1 / 12
End If
'niveau 9 : 15% ou 20% selon les cas (20% pour 2 personnes)
If KelNiv = 9 Then
If NumEmp = Bonus1 Or NumEmp = Bonus2 Then
MontantRef = BaseEmp * 13 * 0.2 / 12
Else
MontantRef = BaseEmp * 13 * 0.15 / 12
End If
End If
End If

rstSuiviS.AddNew
rstSuiviS.Fields("Salarie") = NumEmp
rstSuiviS.Fields("Periode") = KelPer
rstSuiviS.Fields("Prime") = NumP
rstSuiviS.Fields("Montant") = MontantRef
If NumP > 0 And CPOK Then
rstSuiviS.Fields("MontantCP") = rstSuiviS.Fields("Montant") *
TxCP
Else
rstSuiviS.Fields("MontantCP") = 0
End If
rstSuiviS.Update
End If
'============================================= 'La suite n'est à faire qu'une seule fois !!!
If CompteurPrime = 1 Then
'KelTaux = 1

'Par employé et par période...
Dim rstCont As DAO.Recordset
Dim sqlCont As String
sqlCont = "SELECT SuiviSalarieAnnexe.* FROM SuiviSalarieAnnexe " &
_
"WHERE SuiviSalarieAnnexe.Salarie = " & NumEmp & " AND
SuiviSalarieAnnexe.Periode = " & KelPer & ";"

Set rstCont = dbs.OpenRecordset(sqlCont, dbOpenDynaset)
If rstCont.RecordCount <= 0 Then

rstSuiviAnS.AddNew
rstSuiviAnS.Fields("Salarie") = NumEmp
rstSuiviAnS.Fields("Periode") = KelPer
rstSuiviAnS.Fields("CB") = KelCB
rstSuiviAnS.Fields("Niveau") = NumNiv
rstSuiviAnS.Fields("Statut") = KelStatut
rstSuiviAnS.Fields("Taux") = KelTaux
rstSuiviAnS.Fields("TypeContrat") = KelContrat

rstSuiviAnS.Update
End If
End If
'===============================================
rstPP.MoveNext
Loop Until rstPP.EOF

rstP.MoveNext
Loop Until rstP.EOF

Else
'il s'agit d'un employé prévu!!!!
'à traiter différemment !
End If

rstE.MoveNext
Loop Until rstE.EOF
Pbar.Fermer
FinProc:
On Error Resume Next
rstE.Close
rstR.Close
rstP.Close
rstCont.Close
rstPRE.Close
rstEmpAn.Close
rstSuiviS.Close
rstSuiviAnS.Close
Set rstSuiviAnS = Nothing
Set rstSuiviS = Nothing
Set rstEmpAn = Nothing
Set rstPRE = Nothing
Set rstP = Nothing
Set rstCont = Nothing
Set rstE = Nothing
Set rstR = Nothing
Set dbs = Nothing
On Error GoTo 0
End Sub

'====================================================
--

Bien cordialement,

Joël GARBE
www.joelgarbe.fr
"Raymond [mvp]" a écrit dans le message de
news:

Bonsoir Joël.

elle est longue ta boucle ? si non affiche la ici.

est-ce la boucle ou la requête qui est longue ? quel est l'ordre d'idée du
temps nécessaire ?

--
@+
Raymond Access MVP
http://OfficeSystem.Access.free.fr/
http://OfficeSystem.Access.free.fr/runtime/
http://users.skynet.be/mpfa/ pour débuter sur le forum

"Joël GARBE" a écrit dans le message de news:
425eb091$0$3120$
Bonsoir,

Je cherche à gagner du temps dans des procédures où il y a 3 niveaux de
boucles inbriquées.

La procédure fonctionne correctement mais est très lente...

A l'intérieur de chaque boucle, j'effectue une requête me permettant de
récupérer des information sur l'élément de la boucle.

La durée d'exécution est très lente et je cherche un moyen de diminuer
cette durée.

Quel peut être ce moyen ?

Une recherche à la place de la requête .? ou autre chose ?

Toutes propositions sera la bienvenue !!!

Vous en remerciant par avance,
--

Bien cordialement,

Joël GARBE
www.joelgarbe.fr

Merci Raymond,

Puisque tu insistes, on peux tenter le coup (je ne risque rien !)
Sur mon poste (avec 1 année soit 12 mois d'étude et 500 employés : environ 5
minutes maxi)
Sur un autre poste et 24 mois d'étude ... 2 heures !!!!!!!!!!!!!!
Pour chaque employé, pour chaque prime, je dois créer des périodes
(renseigner les primes de chaque employé dans chaque période)

sachant que ma base est structurée :
Table Employes
Table SuiviSalarie (Listant toutes les primes de toutes les période de
chaque employé, soit autant d'enregistrement par employé et par période
qu'il y a de primes)
Table SuiviSalarieAnnexe (Listant les informations de base de chaque employé
pour une période donnée : Niveau, Service, Taux d'emploi, etc... 1 enr par
employé et par période)
Table Periode ... Listant les différentes périodes (Réel (1) Budget (2)
Forecast (3)
'==================================================== Private Sub CalculTout()
'Centre névralgique des Budget et Forecast
'Rechercher les enregistrements à modifier dans la table
'SuiviSalarie et SuiviSalarieAnnexe
'Commencer par passer en revue tous les enregistrements du formulaire
Set dbs = CurrentDb

Set rst = dbs.OpenRecordset("Constantes", dbOpenTable)
TxCP = rst.Fields("TauxChargePatronale")

sql = "SELECT Periodes.* " & _
"FROM Periodes " & _
"WHERE (((Periodes.Reel) = " & IIf(Forms("FormMenuPrinc").CACType, 2, 3)
& ")) " & _
"ORDER BY Periodes.Annee, Periodes.Mois;"

Set rstPP = dbs.OpenRecordset(sql, dbOpenDynaset)

If rstPP.RecordCount = 0 Then
AfficheMessage "Avant de lancer le calcul, il faut générer les périodes" &
Chr(10) & _
"L'opération est annulée"
GoTo FinProc
End If

'déterminer le premier mois et la première année du Budget / Forecast
PremMoisBF = rstPP.Fields("Mois")
PremAnneeBF = rstPP.Fields("Annee")

'Mais avant : Les constantes...
Set rstE = dbs.OpenRecordset("Constantes", dbOpenTable)
If rstE.RecordCount = 0 Then
AfficheMessage "La base de donnée ne contient aucune Constante !!!" &
Chr(10) & _
"L'opération est annulée"
GoTo FinProc
End If
rstE.MoveFirst
MaxAnc = rstE.Fields("MaxAnciennete")
NivRef = rstE.Fields("NivAnciennete")
MontantAbond = rstE.Fields("Abondement")
MontantInter = rstE.Fields("Interessement")
MontantPart = rstE.Fields("Participation")
MontantPres = rstE.Fields("PrimePresenteisme")

Bonus1 = rstE.Fields("Bonus1")
Bonus2 = rstE.Fields("Bonus2")

'On va passer en revue tous les employés...
'Tous ? pour les embauches vérifier si embauche prévue au budget/Forecast
Set rstE = dbs.OpenRecordset("Employes", dbOpenTable)
If rstE.RecordCount = 0 Then
AfficheMessage "La base de donnée ne contient aucun employé !!!" & Chr(10)
& _
"L'opération est annulée"
GoTo FinProc
End If
rstE.MoveLast
NbEmp = rstE.RecordCount

Set rstR = dbs.OpenRecordset("RqReelComplet", dbOpenDynaset)
If rstR.RecordCount > 0 Then
rstR.MoveLast
NbEnrReel = rstR.RecordCount
Else
AfficheMessage "Pour élaborer le budget ou le forecast, il faut avoir
importé au moins un mois complet" & Chr(10) & _
"C'est à dire les 3 fichiers : effectif, base/ancienneté et Primes" &
Chr(10) & Chr(10) & _
"L'opération est annulée"
GoTo FinProc
End If

'si on commençait pas supprimer toutes les périodes du
'SuiviSalarie et SuiviSalarieAnnexe
'Euh... peut-être pas ici ;-)

'================================================================================ 'étude : modifier si la période existe déjà !

sql = "DELETE SuiviSalarie.* " & _
"FROM Periodes INNER JOIN SuiviSalarie ON Periodes.N°Periode =
SuiviSalarie.Periode " & _
"WHERE (((Periodes.Reel)= " & IIf(Forms("FormMenuPrinc").CACType, 2, 3) &
"));"

DoCmd.RunSQL sql
'================================================================================== Set rstP = dbs.OpenRecordset("SuiviSalarie", dbOpenTable)
rstP.MoveLast

'ici le début de la barre de progression
NbCycle = NbEmp
Pbar.Ouvrir
Forms("frmProgressBis").Caption = "MAJ Employé : " & rstE.Fields("Nom") & "
" & rstE.Fields("PreNom")

CompteurBar = NbCycle / 100
RefCompteur = 0

Set rstSuiviS = dbs.OpenRecordset("SuiviSalarie", dbOpenTable)
Set rstSuiviAnS = dbs.OpenRecordset("SuiviSalarieAnnexe", dbOpenTable)

rstE.MoveFirst
'====================================== Do

Forms("frmProgressBis").Caption = "MAJ Employé : " & rstE.Fields("Nom") & "
" & rstE.Fields("Prenom")

RefCompteur = RefCompteur + 1
If RefCompteur = CompteurBar Then
RefCompteur = 0
Pbar.Avancer 1
End If

'Employé par employé
NumEmp = rstE.Fields("N°Salarie")
On Error Resume Next
MoisEmb = Month(rstE.Fields("DateEmbauche"))
AnneeEmb = Year(rstE.Fields("DateEmbauche"))
On Error GoTo 0

'déterminer les informations annexes de base concernant l'employé :
sql = "SELECT SuiviSalarieAnnexe.Periode, Niveaux.Niveau,
SuiviSalarieAnnexe.Salarie, Niveaux.N°Niveau, SuiviSalarieAnnexe.CB,
SuiviSalarieAnnexe.Statut, SuiviSalarieAnnexe.Taux,
SuiviSalarieAnnexe.TypeContrat, Periodes.Reel " & _
"FROM Periodes INNER JOIN (Niveaux INNER JOIN SuiviSalarieAnnexe ON
Niveaux.N°Niveau = SuiviSalarieAnnexe.Niveau) ON Periodes.N°Periode =
SuiviSalarieAnnexe.Periode " & _
"WHERE (((SuiviSalarieAnnexe.Salarie) = " & NumEmp & ") And
((Periodes.Reel) = 1)) " & _
"ORDER BY SuiviSalarieAnnexe.Periode DESC;"

Set rstEmpAn = dbs.OpenRecordset(sql, dbOpenDynaset)

'=====================================================
KelTaux = 1
On Error Resume Next
'Par employé et par période...
NivEmp = rstEmpAn.Fields("Niveau")
NumNiv = rstEmpAn.Fields("N°Niveau")
KelNiv = CInt(Left(rstEmpAn.Fields("Niveau"), 1))
KelCB = rstEmpAn.Fields("CB")
KelStatut = rstEmpAn.Fields("Statut")
KelTaux = rstEmpAn.Fields("Taux")
KelContrat = rstEmpAn.Fields("TypeContrat")

On Error GoTo 0
'=====================================================
'Prime par prime de l'employé des fichiers réels
sql = "SELECT Primes.N°Prime, SuiviSalarie.Salarie, Periodes.Reel " & _
"FROM Periodes INNER JOIN (Primes INNER JOIN SuiviSalarie ON
Primes.N°Prime = SuiviSalarie.Prime) ON Periodes.N°Periode =
SuiviSalarie.Periode " & _
"GROUP BY Primes.N°Prime, SuiviSalarie.Salarie, Periodes.Reel " & _
"HAVING (((SuiviSalarie.Salarie)=" & NumEmp & " AND
((Periodes.Reel)=1)));"

Set rstP = dbs.OpenRecordset(sql, dbOpenDynaset)
If rstP.RecordCount > 0 Then 'Employé réel sinon embauche prévue
rstP.MoveFirst
'============================================= CompteurPrime = 0

Do
CompteurPrime = CompteurPrime + 1
'Prime par prime
NumP = rstP.Fields("N°Prime")
'CodeP = rstP.Fields("CodePrime")
Dim rstPr As DAO.Recordset
sql = "SELECT Primes.* FROM Primes WHERE Primes.N°Prime = " & NumP &
";"
Set rstPr = dbs.OpenRecordset(sql, dbOpenDynaset)
rstPr.MoveFirst
CodeP = rstPr.Fields("CodePrime")
rstPr.Close

Set rstPr = Nothing

sql = "SELECT Primes.N°Prime, SuiviSalarie.Salarie,
SuiviSalarie.Periode, SuiviSalarie.Montant, Periodes.Annee, Periodes.Mois "
& _
"FROM Periodes INNER JOIN (Primes INNER JOIN SuiviSalarie ON
Primes.N°Prime = SuiviSalarie.Prime) ON Periodes.N°Periode =
SuiviSalarie.Periode " & _
"WHERE (((Primes.N°Prime)=" & NumP & ") AND
((SuiviSalarie.Salarie)=" & NumEmp & ")) " & _
"ORDER BY Periodes.Annee DESC , Periodes.Mois DESC;"
'Commencer par déterminer les montants de référence pour chacune des
primes de l'employé
'La moyenne des 5 périodes précédentes !
Set rstPRE = dbs.OpenRecordset(sql, dbOpenDynaset)
rstPRE.MoveFirst
i = 0
MontantRef = 0
Do
MontantRef = rstPRE.Fields("Montant")
If (rstPRE.Fields("Mois") <= PremMoisBF And rstPRE.Fields("Annee") =
PremAnneeBF) Or rstPRE.Fields("Annee") < PremAnneeBF Then
ReDim Preserve MontantPEmp(i)
MontantPEmp(i) = rstPRE.Fields("Montant")
i = i + 1
End If
rstPRE.MoveNext
Loop Until rstPRE.EOF Or i = 5

If i > 0 Then
'il y a eu de période réelle antérieure à la première période du
budget/Forecast trouvée...
MontantRef = 0
'déterminer le montant de référence pour cette prime de cet
employé...
For i = LBound(MontantPEmp()) To UBound(MontantPEmp())
MontantRef = MontantRef + MontantPEmp(i)
Next
MontantRef = MontantRef / (UBound(MontantPEmp()) + 1)
End If
'Injecter ce montant dans le budget / Forecast...
'Attention aux augmentations...
'Déterminer déjà le niveau de l'employé

'Passer maintenant en revue toutes les périodes du formulaire...

rstPP.MoveFirst
CompteurPer = 0
Do
CompteurPer = CompteurPer + 1
'La période existe, c'est obligatoire...
KelPer = rstPP.Fields("N°Periode")

KelMois = rstPP.Fields("Mois")
KelAnnee = rstPP.Fields("Annee")

Select Case KelNiv
Case Is <= 3
If Left(NivEmp, 2) <> "10" Then
MontantRef = MontantRef * (1 + rstPP.Fields("AugmenT1"))
End If
Case 4 To 6
MontantRef = MontantRef * (1 + rstPP.Fields("AugmenT2"))
Case Else
MontantRef = MontantRef * (1 + rstPP.Fields("AugmenT3"))
End Select

If NumP = 2 Then 'Prime d'ancienneté
If KelNiv <= NivRef And Right(NivEmp, 2) <> "6B" And Left(NivEmp,
2) <> "10" Then
sql = "SELECT Primes.N°Prime, SuiviSalarie.Salarie,
Periodes.Reel, SuiviSalarie.Montant, Periodes.N°Periode, Primes.CP " & _
"FROM Periodes INNER JOIN (Primes INNER JOIN SuiviSalarie ON
Primes.N°Prime = SuiviSalarie.Prime) ON Periodes.N°Periode =
SuiviSalarie.Periode " & _
"WHERE (SuiviSalarie.Salarie=" & NumEmp & ") AND
(Periodes.N°Periode=" & KelPer & ") AND (Periodes.Reel=" &
IIf(Forms("FormMenuPrinc").CACType, 2, 3) & ") AND N°Prime=1;"
Dim rsBaseEmp As DAO.Recordset

Set rsBaseEmp = dbs.OpenRecordset(sql, dbOpenDynaset)
rsBaseEmp.MoveFirst
BaseEmp = rsBaseEmp.Fields("Montant")
MontantRef = BaseEmp * (IIf(MaxAnc / 100 > Int(((KelAnnee -
AnneeEmb) * 12 + KelMois - MoisEmb - 1) / 12) / 100, Int(((KelAnnee -
AnneeEmb) * 12 + KelMois - MoisEmb - 1) / 12) / 100, MaxAnc / 100))
End If

'Gratification d'ancienneté 'annulé sur demande de DDL !
GoTo PassGrat
If (KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 120 Then
MontantRef = (MontantRef + BaseEmp) * 0.5 + MontantRef

End If

If (KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 180 Then
MontantRef = (MontantRef + BaseEmp) * 0.75 + MontantRef

End If

If (KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 240 Or _
(KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 300 Or _
(KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 360 Then
MontantRef = (MontantRef + BaseEmp) + MontantRef

End If

If (KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 420 Or _
(KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 480 Then
MontantRef = (MontantRef + BaseEmp) * 2 + MontantRef

End If
PassGrat:

End If
If CodeP = "2042" Or CodeP = "2044" Or _
CodeP = "2048" Or CodeP = "2058" Or CodeP = "9BAP" Or _
CodeP = "/101" Then
Else
Dim rsCP As DAO.Recordset
Set rsCP = dbs.OpenRecordset("SELECT Primes.* FROM Primes WHERE
Primes.N°Prime = " & NumP & ";")
rsCP.MoveFirst

CPOK = rsCP.Fields("CP")

If NumP = 3 Then 'Abondement
MontantRef = MontantAbond
End If
If NumP = 4 Then 'Intéressement
MontantRef = MontantInter
End If
If NumP = 5 Then 'Participation
MontantRef = MontantPart
End If
If NumP = 6 Then 'Présentéïsme
MontantRef = MontantPres
End If
If NumP = 7 Then 'Bonus Or CodeP = "9106"
'tous les mois !
'Niveau 7 et 8 : 10% du salaire annuel
If KelNiv = 7 Or KelNiv = 8 Then
MontantRef = BaseEmp * 13 * 0.1 / 12
End If
'niveau 9 : 15% ou 20% selon les cas (20% pour 2 personnes)
If KelNiv = 9 Then
If NumEmp = Bonus1 Or NumEmp = Bonus2 Then
MontantRef = BaseEmp * 13 * 0.2 / 12
Else
MontantRef = BaseEmp * 13 * 0.15 / 12
End If
End If
End If

rstSuiviS.AddNew
rstSuiviS.Fields("Salarie") = NumEmp
rstSuiviS.Fields("Periode") = KelPer
rstSuiviS.Fields("Prime") = NumP
rstSuiviS.Fields("Montant") = MontantRef
If NumP > 0 And CPOK Then
rstSuiviS.Fields("MontantCP") = rstSuiviS.Fields("Montant") *
TxCP
Else
rstSuiviS.Fields("MontantCP") = 0
End If
rstSuiviS.Update
End If
'============================================= 'La suite n'est à faire qu'une seule fois !!!
If CompteurPrime = 1 Then
'KelTaux = 1

'Par employé et par période...
Dim rstCont As DAO.Recordset
Dim sqlCont As String
sqlCont = "SELECT SuiviSalarieAnnexe.* FROM SuiviSalarieAnnexe " &
_
"WHERE SuiviSalarieAnnexe.Salarie = " & NumEmp & " AND
SuiviSalarieAnnexe.Periode = " & KelPer & ";"

Set rstCont = dbs.OpenRecordset(sqlCont, dbOpenDynaset)
If rstCont.RecordCount <= 0 Then

rstSuiviAnS.AddNew
rstSuiviAnS.Fields("Salarie") = NumEmp
rstSuiviAnS.Fields("Periode") = KelPer
rstSuiviAnS.Fields("CB") = KelCB
rstSuiviAnS.Fields("Niveau") = NumNiv
rstSuiviAnS.Fields("Statut") = KelStatut
rstSuiviAnS.Fields("Taux") = KelTaux
rstSuiviAnS.Fields("TypeContrat") = KelContrat

rstSuiviAnS.Update
End If
End If
'===============================================
rstPP.MoveNext
Loop Until rstPP.EOF

rstP.MoveNext
Loop Until rstP.EOF

Else
'il s'agit d'un employé prévu!!!!
'à traiter différemment !
End If

rstE.MoveNext
Loop Until rstE.EOF
Pbar.Fermer
FinProc:
On Error Resume Next
rstE.Close
rstR.Close
rstP.Close
rstCont.Close
rstPRE.Close
rstEmpAn.Close
rstSuiviS.Close
rstSuiviAnS.Close
Set rstSuiviAnS = Nothing
Set rstSuiviS = Nothing
Set rstEmpAn = Nothing
Set rstPRE = Nothing
Set rstP = Nothing
Set rstCont = Nothing
Set rstE = Nothing
Set rstR = Nothing
Set dbs = Nothing
On Error GoTo 0
End Sub

'====================================================
--

Bien cordialement,

Joël GARBE
www.joelgarbe.fr
"Raymond [mvp]" <XYZ.officesystem.access@free.fr> a écrit dans le message de
news: OdWs6zRQFHA.1268@TK2MSFTNGP14.phx.gbl...

Bonsoir Joël.

elle est longue ta boucle ? si non affiche la ici.

est-ce la boucle ou la requête qui est longue ? quel est l'ordre d'idée du
temps nécessaire ?

--
@+
Raymond Access MVP
http://OfficeSystem.Access.free.fr/
http://OfficeSystem.Access.free.fr/runtime/
http://users.skynet.be/mpfa/ pour débuter sur le forum

"Joël GARBE" <joel-garbe@wanadoo.fr> a écrit dans le message de news:
425eb091$0$3120$8fcfb975@news.wanadoo.fr...

Bonsoir,

Je cherche à gagner du temps dans des procédures où il y a 3 niveaux de
boucles inbriquées.

La procédure fonctionne correctement mais est très lente...

A l'intérieur de chaque boucle, j'effectue une requête me permettant de
récupérer des information sur l'élément de la boucle.

La durée d'exécution est très lente et je cherche un moyen de diminuer
cette durée.

Quel peut être ce moyen ?

Une recherche à la place de la requête .? ou autre chose ?

Toutes propositions sera la bienvenue !!!

Vous en remerciant par avance,
--

Bien cordialement,

Joël GARBE
www.joelgarbe.fr

Vous avez filtré cet utilisateur ! Consultez son message

Merci Raymond,

Puisque tu insistes, on peux tenter le coup (je ne risque rien !)
Sur mon poste (avec 1 année soit 12 mois d'étude et 500 employés : environ 5
minutes maxi)
Sur un autre poste et 24 mois d'étude ... 2 heures !!!!!!!!!!!!!!
Pour chaque employé, pour chaque prime, je dois créer des périodes
(renseigner les primes de chaque employé dans chaque période)

sachant que ma base est structurée :
Table Employes
Table SuiviSalarie (Listant toutes les primes de toutes les période de
chaque employé, soit autant d'enregistrement par employé et par période
qu'il y a de primes)
Table SuiviSalarieAnnexe (Listant les informations de base de chaque employé
pour une période donnée : Niveau, Service, Taux d'emploi, etc... 1 enr par
employé et par période)
Table Periode ... Listant les différentes périodes (Réel (1) Budget (2)
Forecast (3)
'==================================================== Private Sub CalculTout()
'Centre névralgique des Budget et Forecast
'Rechercher les enregistrements à modifier dans la table
'SuiviSalarie et SuiviSalarieAnnexe
'Commencer par passer en revue tous les enregistrements du formulaire
Set dbs = CurrentDb

Set rst = dbs.OpenRecordset("Constantes", dbOpenTable)
TxCP = rst.Fields("TauxChargePatronale")

sql = "SELECT Periodes.* " & _
"FROM Periodes " & _
"WHERE (((Periodes.Reel) = " & IIf(Forms("FormMenuPrinc").CACType, 2, 3)
& ")) " & _
"ORDER BY Periodes.Annee, Periodes.Mois;"

Set rstPP = dbs.OpenRecordset(sql, dbOpenDynaset)

If rstPP.RecordCount = 0 Then
AfficheMessage "Avant de lancer le calcul, il faut générer les périodes" &
Chr(10) & _
"L'opération est annulée"
GoTo FinProc
End If

'déterminer le premier mois et la première année du Budget / Forecast
PremMoisBF = rstPP.Fields("Mois")
PremAnneeBF = rstPP.Fields("Annee")

'Mais avant : Les constantes...
Set rstE = dbs.OpenRecordset("Constantes", dbOpenTable)
If rstE.RecordCount = 0 Then
AfficheMessage "La base de donnée ne contient aucune Constante !!!" &
Chr(10) & _
"L'opération est annulée"
GoTo FinProc
End If
rstE.MoveFirst
MaxAnc = rstE.Fields("MaxAnciennete")
NivRef = rstE.Fields("NivAnciennete")
MontantAbond = rstE.Fields("Abondement")
MontantInter = rstE.Fields("Interessement")
MontantPart = rstE.Fields("Participation")
MontantPres = rstE.Fields("PrimePresenteisme")

Bonus1 = rstE.Fields("Bonus1")
Bonus2 = rstE.Fields("Bonus2")

'On va passer en revue tous les employés...
'Tous ? pour les embauches vérifier si embauche prévue au budget/Forecast
Set rstE = dbs.OpenRecordset("Employes", dbOpenTable)
If rstE.RecordCount = 0 Then
AfficheMessage "La base de donnée ne contient aucun employé !!!" & Chr(10)
& _
"L'opération est annulée"
GoTo FinProc
End If
rstE.MoveLast
NbEmp = rstE.RecordCount

Set rstR = dbs.OpenRecordset("RqReelComplet", dbOpenDynaset)
If rstR.RecordCount > 0 Then
rstR.MoveLast
NbEnrReel = rstR.RecordCount
Else
AfficheMessage "Pour élaborer le budget ou le forecast, il faut avoir
importé au moins un mois complet" & Chr(10) & _
"C'est à dire les 3 fichiers : effectif, base/ancienneté et Primes" &
Chr(10) & Chr(10) & _
"L'opération est annulée"
GoTo FinProc
End If

'si on commençait pas supprimer toutes les périodes du
'SuiviSalarie et SuiviSalarieAnnexe
'Euh... peut-être pas ici ;-)

'================================================================================ 'étude : modifier si la période existe déjà !

sql = "DELETE SuiviSalarie.* " & _
"FROM Periodes INNER JOIN SuiviSalarie ON Periodes.N°Periode =
SuiviSalarie.Periode " & _
"WHERE (((Periodes.Reel)= " & IIf(Forms("FormMenuPrinc").CACType, 2, 3) &
"));"

DoCmd.RunSQL sql
'================================================================================== Set rstP = dbs.OpenRecordset("SuiviSalarie", dbOpenTable)
rstP.MoveLast

'ici le début de la barre de progression
NbCycle = NbEmp
Pbar.Ouvrir
Forms("frmProgressBis").Caption = "MAJ Employé : " & rstE.Fields("Nom") & "
" & rstE.Fields("PreNom")

CompteurBar = NbCycle / 100
RefCompteur = 0

Set rstSuiviS = dbs.OpenRecordset("SuiviSalarie", dbOpenTable)
Set rstSuiviAnS = dbs.OpenRecordset("SuiviSalarieAnnexe", dbOpenTable)

rstE.MoveFirst
'====================================== Do

Forms("frmProgressBis").Caption = "MAJ Employé : " & rstE.Fields("Nom") & "
" & rstE.Fields("Prenom")

RefCompteur = RefCompteur + 1
If RefCompteur = CompteurBar Then
RefCompteur = 0
Pbar.Avancer 1
End If

'Employé par employé
NumEmp = rstE.Fields("N°Salarie")
On Error Resume Next
MoisEmb = Month(rstE.Fields("DateEmbauche"))
AnneeEmb = Year(rstE.Fields("DateEmbauche"))
On Error GoTo 0

'déterminer les informations annexes de base concernant l'employé :
sql = "SELECT SuiviSalarieAnnexe.Periode, Niveaux.Niveau,
SuiviSalarieAnnexe.Salarie, Niveaux.N°Niveau, SuiviSalarieAnnexe.CB,
SuiviSalarieAnnexe.Statut, SuiviSalarieAnnexe.Taux,
SuiviSalarieAnnexe.TypeContrat, Periodes.Reel " & _
"FROM Periodes INNER JOIN (Niveaux INNER JOIN SuiviSalarieAnnexe ON
Niveaux.N°Niveau = SuiviSalarieAnnexe.Niveau) ON Periodes.N°Periode =
SuiviSalarieAnnexe.Periode " & _
"WHERE (((SuiviSalarieAnnexe.Salarie) = " & NumEmp & ") And
((Periodes.Reel) = 1)) " & _
"ORDER BY SuiviSalarieAnnexe.Periode DESC;"

Set rstEmpAn = dbs.OpenRecordset(sql, dbOpenDynaset)

'=====================================================
KelTaux = 1
On Error Resume Next
'Par employé et par période...
NivEmp = rstEmpAn.Fields("Niveau")
NumNiv = rstEmpAn.Fields("N°Niveau")
KelNiv = CInt(Left(rstEmpAn.Fields("Niveau"), 1))
KelCB = rstEmpAn.Fields("CB")
KelStatut = rstEmpAn.Fields("Statut")
KelTaux = rstEmpAn.Fields("Taux")
KelContrat = rstEmpAn.Fields("TypeContrat")

On Error GoTo 0
'=====================================================
'Prime par prime de l'employé des fichiers réels
sql = "SELECT Primes.N°Prime, SuiviSalarie.Salarie, Periodes.Reel " & _
"FROM Periodes INNER JOIN (Primes INNER JOIN SuiviSalarie ON
Primes.N°Prime = SuiviSalarie.Prime) ON Periodes.N°Periode =
SuiviSalarie.Periode " & _
"GROUP BY Primes.N°Prime, SuiviSalarie.Salarie, Periodes.Reel " & _
"HAVING (((SuiviSalarie.Salarie)=" & NumEmp & " AND
((Periodes.Reel)=1)));"

Set rstP = dbs.OpenRecordset(sql, dbOpenDynaset)
If rstP.RecordCount > 0 Then 'Employé réel sinon embauche prévue
rstP.MoveFirst
'============================================= CompteurPrime = 0

Do
CompteurPrime = CompteurPrime + 1
'Prime par prime
NumP = rstP.Fields("N°Prime")
'CodeP = rstP.Fields("CodePrime")
Dim rstPr As DAO.Recordset
sql = "SELECT Primes.* FROM Primes WHERE Primes.N°Prime = " & NumP &
";"
Set rstPr = dbs.OpenRecordset(sql, dbOpenDynaset)
rstPr.MoveFirst
CodeP = rstPr.Fields("CodePrime")
rstPr.Close

Set rstPr = Nothing

sql = "SELECT Primes.N°Prime, SuiviSalarie.Salarie,
SuiviSalarie.Periode, SuiviSalarie.Montant, Periodes.Annee, Periodes.Mois "
& _
"FROM Periodes INNER JOIN (Primes INNER JOIN SuiviSalarie ON
Primes.N°Prime = SuiviSalarie.Prime) ON Periodes.N°Periode =
SuiviSalarie.Periode " & _
"WHERE (((Primes.N°Prime)=" & NumP & ") AND
((SuiviSalarie.Salarie)=" & NumEmp & ")) " & _
"ORDER BY Periodes.Annee DESC , Periodes.Mois DESC;"
'Commencer par déterminer les montants de référence pour chacune des
primes de l'employé
'La moyenne des 5 périodes précédentes !
Set rstPRE = dbs.OpenRecordset(sql, dbOpenDynaset)
rstPRE.MoveFirst
i = 0
MontantRef = 0
Do
MontantRef = rstPRE.Fields("Montant")
If (rstPRE.Fields("Mois") <= PremMoisBF And rstPRE.Fields("Annee") =
PremAnneeBF) Or rstPRE.Fields("Annee") < PremAnneeBF Then
ReDim Preserve MontantPEmp(i)
MontantPEmp(i) = rstPRE.Fields("Montant")
i = i + 1
End If
rstPRE.MoveNext
Loop Until rstPRE.EOF Or i = 5

If i > 0 Then
'il y a eu de période réelle antérieure à la première période du
budget/Forecast trouvée...
MontantRef = 0
'déterminer le montant de référence pour cette prime de cet
employé...
For i = LBound(MontantPEmp()) To UBound(MontantPEmp())
MontantRef = MontantRef + MontantPEmp(i)
Next
MontantRef = MontantRef / (UBound(MontantPEmp()) + 1)
End If
'Injecter ce montant dans le budget / Forecast...
'Attention aux augmentations...
'Déterminer déjà le niveau de l'employé

'Passer maintenant en revue toutes les périodes du formulaire...

rstPP.MoveFirst
CompteurPer = 0
Do
CompteurPer = CompteurPer + 1
'La période existe, c'est obligatoire...
KelPer = rstPP.Fields("N°Periode")

KelMois = rstPP.Fields("Mois")
KelAnnee = rstPP.Fields("Annee")

Select Case KelNiv
Case Is <= 3
If Left(NivEmp, 2) <> "10" Then
MontantRef = MontantRef * (1 + rstPP.Fields("AugmenT1"))
End If
Case 4 To 6
MontantRef = MontantRef * (1 + rstPP.Fields("AugmenT2"))
Case Else
MontantRef = MontantRef * (1 + rstPP.Fields("AugmenT3"))
End Select

If NumP = 2 Then 'Prime d'ancienneté
If KelNiv <= NivRef And Right(NivEmp, 2) <> "6B" And Left(NivEmp,
2) <> "10" Then
sql = "SELECT Primes.N°Prime, SuiviSalarie.Salarie,
Periodes.Reel, SuiviSalarie.Montant, Periodes.N°Periode, Primes.CP " & _
"FROM Periodes INNER JOIN (Primes INNER JOIN SuiviSalarie ON
Primes.N°Prime = SuiviSalarie.Prime) ON Periodes.N°Periode =
SuiviSalarie.Periode " & _
"WHERE (SuiviSalarie.Salarie=" & NumEmp & ") AND
(Periodes.N°Periode=" & KelPer & ") AND (Periodes.Reel=" &
IIf(Forms("FormMenuPrinc").CACType, 2, 3) & ") AND N°Prime=1;"
Dim rsBaseEmp As DAO.Recordset

Set rsBaseEmp = dbs.OpenRecordset(sql, dbOpenDynaset)
rsBaseEmp.MoveFirst
BaseEmp = rsBaseEmp.Fields("Montant")
MontantRef = BaseEmp * (IIf(MaxAnc / 100 > Int(((KelAnnee -
AnneeEmb) * 12 + KelMois - MoisEmb - 1) / 12) / 100, Int(((KelAnnee -
AnneeEmb) * 12 + KelMois - MoisEmb - 1) / 12) / 100, MaxAnc / 100))
End If

'Gratification d'ancienneté 'annulé sur demande de DDL !
GoTo PassGrat
If (KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 120 Then
MontantRef = (MontantRef + BaseEmp) * 0.5 + MontantRef

End If

If (KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 180 Then
MontantRef = (MontantRef + BaseEmp) * 0.75 + MontantRef

End If

If (KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 240 Or _
(KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 300 Or _
(KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 360 Then
MontantRef = (MontantRef + BaseEmp) + MontantRef

End If

If (KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 420 Or _
(KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 480 Then
MontantRef = (MontantRef + BaseEmp) * 2 + MontantRef

End If
PassGrat:

End If
If CodeP = "2042" Or CodeP = "2044" Or _
CodeP = "2048" Or CodeP = "2058" Or CodeP = "9BAP" Or _
CodeP = "/101" Then
Else
Dim rsCP As DAO.Recordset
Set rsCP = dbs.OpenRecordset("SELECT Primes.* FROM Primes WHERE
Primes.N°Prime = " & NumP & ";")
rsCP.MoveFirst

CPOK = rsCP.Fields("CP")

If NumP = 3 Then 'Abondement
MontantRef = MontantAbond
End If
If NumP = 4 Then 'Intéressement
MontantRef = MontantInter
End If
If NumP = 5 Then 'Participation
MontantRef = MontantPart
End If
If NumP = 6 Then 'Présentéïsme
MontantRef = MontantPres
End If
If NumP = 7 Then 'Bonus Or CodeP = "9106"
'tous les mois !
'Niveau 7 et 8 : 10% du salaire annuel
If KelNiv = 7 Or KelNiv = 8 Then
MontantRef = BaseEmp * 13 * 0.1 / 12
End If
'niveau 9 : 15% ou 20% selon les cas (20% pour 2 personnes)
If KelNiv = 9 Then
If NumEmp = Bonus1 Or NumEmp = Bonus2 Then
MontantRef = BaseEmp * 13 * 0.2 / 12
Else
MontantRef = BaseEmp * 13 * 0.15 / 12
End If
End If
End If

rstSuiviS.AddNew
rstSuiviS.Fields("Salarie") = NumEmp
rstSuiviS.Fields("Periode") = KelPer
rstSuiviS.Fields("Prime") = NumP
rstSuiviS.Fields("Montant") = MontantRef
If NumP > 0 And CPOK Then
rstSuiviS.Fields("MontantCP") = rstSuiviS.Fields("Montant") *
TxCP
Else
rstSuiviS.Fields("MontantCP") = 0
End If
rstSuiviS.Update
End If
'============================================= 'La suite n'est à faire qu'une seule fois !!!
If CompteurPrime = 1 Then
'KelTaux = 1

'Par employé et par période...
Dim rstCont As DAO.Recordset
Dim sqlCont As String
sqlCont = "SELECT SuiviSalarieAnnexe.* FROM SuiviSalarieAnnexe " &
_
"WHERE SuiviSalarieAnnexe.Salarie = " & NumEmp & " AND
SuiviSalarieAnnexe.Periode = " & KelPer & ";"

Set rstCont = dbs.OpenRecordset(sqlCont, dbOpenDynaset)
If rstCont.RecordCount <= 0 Then

rstSuiviAnS.AddNew
rstSuiviAnS.Fields("Salarie") = NumEmp
rstSuiviAnS.Fields("Periode") = KelPer
rstSuiviAnS.Fields("CB") = KelCB
rstSuiviAnS.Fields("Niveau") = NumNiv
rstSuiviAnS.Fields("Statut") = KelStatut
rstSuiviAnS.Fields("Taux") = KelTaux
rstSuiviAnS.Fields("TypeContrat") = KelContrat

rstSuiviAnS.Update
End If
End If
'===============================================
rstPP.MoveNext
Loop Until rstPP.EOF

rstP.MoveNext
Loop Until rstP.EOF

Else
'il s'agit d'un employé prévu!!!!
'à traiter différemment !
End If

rstE.MoveNext
Loop Until rstE.EOF
Pbar.Fermer
FinProc:
On Error Resume Next
rstE.Close
rstR.Close
rstP.Close
rstCont.Close
rstPRE.Close
rstEmpAn.Close
rstSuiviS.Close
rstSuiviAnS.Close
Set rstSuiviAnS = Nothing
Set rstSuiviS = Nothing
Set rstEmpAn = Nothing
Set rstPRE = Nothing
Set rstP = Nothing
Set rstCont = Nothing
Set rstE = Nothing
Set rstR = Nothing
Set dbs = Nothing
On Error GoTo 0
End Sub

'====================================================
--

Bien cordialement,

Joël GARBE
www.joelgarbe.fr
"Raymond [mvp]" a écrit dans le message de
news:

Bonsoir Joël.

elle est longue ta boucle ? si non affiche la ici.

est-ce la boucle ou la requête qui est longue ? quel est l'ordre d'idée du
temps nécessaire ?

--
@+
Raymond Access MVP
http://OfficeSystem.Access.free.fr/
http://OfficeSystem.Access.free.fr/runtime/
http://users.skynet.be/mpfa/ pour débuter sur le forum

"Joël GARBE" a écrit dans le message de news:
425eb091$0$3120$
Bonsoir,

Je cherche à gagner du temps dans des procédures où il y a 3 niveaux de
boucles inbriquées.

La procédure fonctionne correctement mais est très lente...

A l'intérieur de chaque boucle, j'effectue une requête me permettant de
récupérer des information sur l'élément de la boucle.

La durée d'exécution est très lente et je cherche un moyen de diminuer
cette durée.

Quel peut être ce moyen ?

Une recherche à la place de la requête .? ou autre chose ?

Toutes propositions sera la bienvenue !!!

Vous en remerciant par avance,
--

Bien cordialement,

Joël GARBE
www.joelgarbe.fr

Raymond [mvp]

14/04/2005 à 20:27

ça va pas aller tout seul.

la différence de matos ? processeur ? disque dur ?
(je t'avais dit, si elle n'est pas trop longue. )
--
@+
Raymond Access MVP
http://OfficeSystem.Access.free.fr/
http://OfficeSystem.Access.free.fr/runtime/
http://users.skynet.be/mpfa/ pour débuter sur le forum

"Joël GARBE" a écrit dans le message de news:
425eb4c8$0$19325$

Merci Raymond,

Puisque tu insistes, on peux tenter le coup (je ne risque rien !)
Sur mon poste (avec 1 année soit 12 mois d'étude et 500 employés : environ
5 minutes maxi)
Sur un autre poste et 24 mois d'étude ... 2 heures !!!!!!!!!!!!!!
Pour chaque employé, pour chaque prime, je dois créer des périodes
(renseigner les primes de chaque employé dans chaque période)

sachant que ma base est structurée :
Table Employes
Table SuiviSalarie (Listant toutes les primes de toutes les période de
chaque employé, soit autant d'enregistrement par employé et par période
qu'il y a de primes)
Table SuiviSalarieAnnexe (Listant les informations de base de chaque
employé pour une période donnée : Niveau, Service, Taux d'emploi, etc... 1
enr par employé et par période)
Table Periode ... Listant les différentes périodes (Réel (1) Budget (2)
Forecast (3)
'==================================================== > Private Sub CalculTout()
'Centre névralgique des Budget et Forecast
'Rechercher les enregistrements à modifier dans la table
'SuiviSalarie et SuiviSalarieAnnexe
'Commencer par passer en revue tous les enregistrements du formulaire
Set dbs = CurrentDb

Set rst = dbs.OpenRecordset("Constantes", dbOpenTable)
TxCP = rst.Fields("TauxChargePatronale")

sql = "SELECT Periodes.* " & _
"FROM Periodes " & _
"WHERE (((Periodes.Reel) = " & IIf(Forms("FormMenuPrinc").CACType, 2,
3) & ")) " & _
"ORDER BY Periodes.Annee, Periodes.Mois;"

Set rstPP = dbs.OpenRecordset(sql, dbOpenDynaset)

If rstPP.RecordCount = 0 Then
AfficheMessage "Avant de lancer le calcul, il faut générer les périodes"
& Chr(10) & _
"L'opération est annulée"
GoTo FinProc
End If

'déterminer le premier mois et la première année du Budget / Forecast
PremMoisBF = rstPP.Fields("Mois")
PremAnneeBF = rstPP.Fields("Annee")

'Mais avant : Les constantes...
Set rstE = dbs.OpenRecordset("Constantes", dbOpenTable)
If rstE.RecordCount = 0 Then
AfficheMessage "La base de donnée ne contient aucune Constante !!!" &
Chr(10) & _
"L'opération est annulée"
GoTo FinProc
End If
rstE.MoveFirst
MaxAnc = rstE.Fields("MaxAnciennete")
NivRef = rstE.Fields("NivAnciennete")
MontantAbond = rstE.Fields("Abondement")
MontantInter = rstE.Fields("Interessement")
MontantPart = rstE.Fields("Participation")
MontantPres = rstE.Fields("PrimePresenteisme")

Bonus1 = rstE.Fields("Bonus1")
Bonus2 = rstE.Fields("Bonus2")

'On va passer en revue tous les employés...
'Tous ? pour les embauches vérifier si embauche prévue au budget/Forecast
Set rstE = dbs.OpenRecordset("Employes", dbOpenTable)
If rstE.RecordCount = 0 Then
AfficheMessage "La base de donnée ne contient aucun employé !!!" &
Chr(10) & _
"L'opération est annulée"
GoTo FinProc
End If
rstE.MoveLast
NbEmp = rstE.RecordCount

Set rstR = dbs.OpenRecordset("RqReelComplet", dbOpenDynaset)
If rstR.RecordCount > 0 Then
rstR.MoveLast
NbEnrReel = rstR.RecordCount
Else
AfficheMessage "Pour élaborer le budget ou le forecast, il faut avoir
importé au moins un mois complet" & Chr(10) & _
"C'est à dire les 3 fichiers : effectif, base/ancienneté et Primes" &
Chr(10) & Chr(10) & _
"L'opération est annulée"
GoTo FinProc
End If

'si on commençait pas supprimer toutes les périodes du
'SuiviSalarie et SuiviSalarieAnnexe
'Euh... peut-être pas ici ;-)

'================================================================================ > 'étude : modifier si la période existe déjà !

sql = "DELETE SuiviSalarie.* " & _
"FROM Periodes INNER JOIN SuiviSalarie ON Periodes.N°Periode =
SuiviSalarie.Periode " & _
"WHERE (((Periodes.Reel)= " & IIf(Forms("FormMenuPrinc").CACType, 2, 3) &
"));"

DoCmd.RunSQL sql
'================================================================================== > Set rstP = dbs.OpenRecordset("SuiviSalarie", dbOpenTable)
rstP.MoveLast

'ici le début de la barre de progression
NbCycle = NbEmp
Pbar.Ouvrir
Forms("frmProgressBis").Caption = "MAJ Employé : " & rstE.Fields("Nom") &
" " & rstE.Fields("PreNom")

CompteurBar = NbCycle / 100
RefCompteur = 0

Set rstSuiviS = dbs.OpenRecordset("SuiviSalarie", dbOpenTable)
Set rstSuiviAnS = dbs.OpenRecordset("SuiviSalarieAnnexe", dbOpenTable)

rstE.MoveFirst
'====================================== > Do

Forms("frmProgressBis").Caption = "MAJ Employé : " & rstE.Fields("Nom") &
" " & rstE.Fields("Prenom")

RefCompteur = RefCompteur + 1
If RefCompteur = CompteurBar Then
RefCompteur = 0
Pbar.Avancer 1
End If

'Employé par employé
NumEmp = rstE.Fields("N°Salarie")
On Error Resume Next
MoisEmb = Month(rstE.Fields("DateEmbauche"))
AnneeEmb = Year(rstE.Fields("DateEmbauche"))
On Error GoTo 0

'déterminer les informations annexes de base concernant l'employé :
sql = "SELECT SuiviSalarieAnnexe.Periode, Niveaux.Niveau,
SuiviSalarieAnnexe.Salarie, Niveaux.N°Niveau, SuiviSalarieAnnexe.CB,
SuiviSalarieAnnexe.Statut, SuiviSalarieAnnexe.Taux,
SuiviSalarieAnnexe.TypeContrat, Periodes.Reel " & _
"FROM Periodes INNER JOIN (Niveaux INNER JOIN SuiviSalarieAnnexe ON
Niveaux.N°Niveau = SuiviSalarieAnnexe.Niveau) ON Periodes.N°Periode =
SuiviSalarieAnnexe.Periode " & _
"WHERE (((SuiviSalarieAnnexe.Salarie) = " & NumEmp & ") And
((Periodes.Reel) = 1)) " & _
"ORDER BY SuiviSalarieAnnexe.Periode DESC;"

Set rstEmpAn = dbs.OpenRecordset(sql, dbOpenDynaset)

'===================================================== >
KelTaux = 1
On Error Resume Next
'Par employé et par période...
NivEmp = rstEmpAn.Fields("Niveau")
NumNiv = rstEmpAn.Fields("N°Niveau")
KelNiv = CInt(Left(rstEmpAn.Fields("Niveau"), 1))
KelCB = rstEmpAn.Fields("CB")
KelStatut = rstEmpAn.Fields("Statut")
KelTaux = rstEmpAn.Fields("Taux")
KelContrat = rstEmpAn.Fields("TypeContrat")

On Error GoTo 0
'===================================================== >
'Prime par prime de l'employé des fichiers réels
sql = "SELECT Primes.N°Prime, SuiviSalarie.Salarie, Periodes.Reel " & _
"FROM Periodes INNER JOIN (Primes INNER JOIN SuiviSalarie ON
Primes.N°Prime = SuiviSalarie.Prime) ON Periodes.N°Periode =
SuiviSalarie.Periode " & _
"GROUP BY Primes.N°Prime, SuiviSalarie.Salarie, Periodes.Reel " & _
"HAVING (((SuiviSalarie.Salarie)=" & NumEmp & " AND
((Periodes.Reel)=1)));"

Set rstP = dbs.OpenRecordset(sql, dbOpenDynaset)
If rstP.RecordCount > 0 Then 'Employé réel sinon embauche prévue
rstP.MoveFirst
'============================================= > CompteurPrime = 0

Do
CompteurPrime = CompteurPrime + 1
'Prime par prime
NumP = rstP.Fields("N°Prime")
'CodeP = rstP.Fields("CodePrime")
Dim rstPr As DAO.Recordset
sql = "SELECT Primes.* FROM Primes WHERE Primes.N°Prime = " & NumP &
";"
Set rstPr = dbs.OpenRecordset(sql, dbOpenDynaset)
rstPr.MoveFirst
CodeP = rstPr.Fields("CodePrime")
rstPr.Close

Set rstPr = Nothing

sql = "SELECT Primes.N°Prime, SuiviSalarie.Salarie,
SuiviSalarie.Periode, SuiviSalarie.Montant, Periodes.Annee, Periodes.Mois
" & _
"FROM Periodes INNER JOIN (Primes INNER JOIN SuiviSalarie ON
Primes.N°Prime = SuiviSalarie.Prime) ON Periodes.N°Periode =
SuiviSalarie.Periode " & _
"WHERE (((Primes.N°Prime)=" & NumP & ") AND
((SuiviSalarie.Salarie)=" & NumEmp & ")) " & _
"ORDER BY Periodes.Annee DESC , Periodes.Mois DESC;"
'Commencer par déterminer les montants de référence pour chacune des
primes de l'employé
'La moyenne des 5 périodes précédentes !
Set rstPRE = dbs.OpenRecordset(sql, dbOpenDynaset)
rstPRE.MoveFirst
i = 0
MontantRef = 0
Do
MontantRef = rstPRE.Fields("Montant")
If (rstPRE.Fields("Mois") <= PremMoisBF And rstPRE.Fields("Annee")
= PremAnneeBF) Or rstPRE.Fields("Annee") < PremAnneeBF Then
ReDim Preserve MontantPEmp(i)
MontantPEmp(i) = rstPRE.Fields("Montant")
i = i + 1
End If
rstPRE.MoveNext
Loop Until rstPRE.EOF Or i = 5

If i > 0 Then
'il y a eu de période réelle antérieure à la première période du
budget/Forecast trouvée...
MontantRef = 0
'déterminer le montant de référence pour cette prime de cet
employé...
For i = LBound(MontantPEmp()) To UBound(MontantPEmp())
MontantRef = MontantRef + MontantPEmp(i)
Next
MontantRef = MontantRef / (UBound(MontantPEmp()) + 1)
End If
'Injecter ce montant dans le budget / Forecast...
'Attention aux augmentations...
'Déterminer déjà le niveau de l'employé

'Passer maintenant en revue toutes les périodes du formulaire...

rstPP.MoveFirst
CompteurPer = 0
Do
CompteurPer = CompteurPer + 1
'La période existe, c'est obligatoire...
KelPer = rstPP.Fields("N°Periode")

KelMois = rstPP.Fields("Mois")
KelAnnee = rstPP.Fields("Annee")

Select Case KelNiv
Case Is <= 3
If Left(NivEmp, 2) <> "10" Then
MontantRef = MontantRef * (1 + rstPP.Fields("AugmenT1"))
End If
Case 4 To 6
MontantRef = MontantRef * (1 + rstPP.Fields("AugmenT2"))
Case Else
MontantRef = MontantRef * (1 + rstPP.Fields("AugmenT3"))
End Select

If NumP = 2 Then 'Prime d'ancienneté
If KelNiv <= NivRef And Right(NivEmp, 2) <> "6B" And Left(NivEmp,
2) <> "10" Then
sql = "SELECT Primes.N°Prime, SuiviSalarie.Salarie,
Periodes.Reel, SuiviSalarie.Montant, Periodes.N°Periode, Primes.CP " & _
"FROM Periodes INNER JOIN (Primes INNER JOIN SuiviSalarie ON
Primes.N°Prime = SuiviSalarie.Prime) ON Periodes.N°Periode =
SuiviSalarie.Periode " & _
"WHERE (SuiviSalarie.Salarie=" & NumEmp & ") AND
(Periodes.N°Periode=" & KelPer & ") AND (Periodes.Reel=" &
IIf(Forms("FormMenuPrinc").CACType, 2, 3) & ") AND N°Prime=1;"
Dim rsBaseEmp As DAO.Recordset

Set rsBaseEmp = dbs.OpenRecordset(sql, dbOpenDynaset)
rsBaseEmp.MoveFirst
BaseEmp = rsBaseEmp.Fields("Montant")
MontantRef = BaseEmp * (IIf(MaxAnc / 100 > Int(((KelAnnee -
AnneeEmb) * 12 + KelMois - MoisEmb - 1) / 12) / 100, Int(((KelAnnee -
AnneeEmb) * 12 + KelMois - MoisEmb - 1) / 12) / 100, MaxAnc / 100))
End If

'Gratification d'ancienneté 'annulé sur demande de DDL !
GoTo PassGrat
If (KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 120 Then
MontantRef = (MontantRef + BaseEmp) * 0.5 + MontantRef

End If

If (KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 180 Then
MontantRef = (MontantRef + BaseEmp) * 0.75 + MontantRef

End If

If (KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 240 Or _
(KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 300 Or _
(KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 360 Then
MontantRef = (MontantRef + BaseEmp) + MontantRef

End If

If (KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 420 Or _
(KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 480 Then
MontantRef = (MontantRef + BaseEmp) * 2 + MontantRef

End If
PassGrat:

End If
If CodeP = "2042" Or CodeP = "2044" Or _
CodeP = "2048" Or CodeP = "2058" Or CodeP = "9BAP" Or _
CodeP = "/101" Then
Else
Dim rsCP As DAO.Recordset
Set rsCP = dbs.OpenRecordset("SELECT Primes.* FROM Primes WHERE
Primes.N°Prime = " & NumP & ";")
rsCP.MoveFirst

CPOK = rsCP.Fields("CP")

If NumP = 3 Then 'Abondement
MontantRef = MontantAbond
End If
If NumP = 4 Then 'Intéressement
MontantRef = MontantInter
End If
If NumP = 5 Then 'Participation
MontantRef = MontantPart
End If
If NumP = 6 Then 'Présentéïsme
MontantRef = MontantPres
End If
If NumP = 7 Then 'Bonus Or CodeP = "9106"
'tous les mois !
'Niveau 7 et 8 : 10% du salaire annuel
If KelNiv = 7 Or KelNiv = 8 Then
MontantRef = BaseEmp * 13 * 0.1 / 12
End If
'niveau 9 : 15% ou 20% selon les cas (20% pour 2 personnes)
If KelNiv = 9 Then
If NumEmp = Bonus1 Or NumEmp = Bonus2 Then
MontantRef = BaseEmp * 13 * 0.2 / 12
Else
MontantRef = BaseEmp * 13 * 0.15 / 12
End If
End If
End If

rstSuiviS.AddNew
rstSuiviS.Fields("Salarie") = NumEmp
rstSuiviS.Fields("Periode") = KelPer
rstSuiviS.Fields("Prime") = NumP
rstSuiviS.Fields("Montant") = MontantRef
If NumP > 0 And CPOK Then
rstSuiviS.Fields("MontantCP") = rstSuiviS.Fields("Montant") *
TxCP
Else
rstSuiviS.Fields("MontantCP") = 0
End If
rstSuiviS.Update
End If
'============================================= > 'La suite n'est à faire qu'une seule fois !!!
If CompteurPrime = 1 Then
'KelTaux = 1

'Par employé et par période...
Dim rstCont As DAO.Recordset
Dim sqlCont As String
sqlCont = "SELECT SuiviSalarieAnnexe.* FROM SuiviSalarieAnnexe "
& _
"WHERE SuiviSalarieAnnexe.Salarie = " & NumEmp & " AND
SuiviSalarieAnnexe.Periode = " & KelPer & ";"

Set rstCont = dbs.OpenRecordset(sqlCont, dbOpenDynaset)
If rstCont.RecordCount <= 0 Then

rstSuiviAnS.AddNew
rstSuiviAnS.Fields("Salarie") = NumEmp
rstSuiviAnS.Fields("Periode") = KelPer
rstSuiviAnS.Fields("CB") = KelCB
rstSuiviAnS.Fields("Niveau") = NumNiv
rstSuiviAnS.Fields("Statut") = KelStatut
rstSuiviAnS.Fields("Taux") = KelTaux
rstSuiviAnS.Fields("TypeContrat") = KelContrat

rstSuiviAnS.Update
End If
End If
'=============================================== >
rstPP.MoveNext
Loop Until rstPP.EOF

rstP.MoveNext
Loop Until rstP.EOF

Else
'il s'agit d'un employé prévu!!!!
'à traiter différemment !
End If

rstE.MoveNext
Loop Until rstE.EOF
Pbar.Fermer
FinProc:
On Error Resume Next
rstE.Close
rstR.Close
rstP.Close
rstCont.Close
rstPRE.Close
rstEmpAn.Close
rstSuiviS.Close
rstSuiviAnS.Close
Set rstSuiviAnS = Nothing
Set rstSuiviS = Nothing
Set rstEmpAn = Nothing
Set rstPRE = Nothing
Set rstP = Nothing
Set rstCont = Nothing
Set rstE = Nothing
Set rstR = Nothing
Set dbs = Nothing
On Error GoTo 0
End Sub

'==================================================== >
--

Bien cordialement,

Joël GARBE
www.joelgarbe.fr
"Raymond [mvp]" a écrit dans le message
de news:
Bonsoir Joël.

elle est longue ta boucle ? si non affiche la ici.

est-ce la boucle ou la requête qui est longue ? quel est l'ordre d'idée
du temps nécessaire ?

--
@+
Raymond Access MVP
http://OfficeSystem.Access.free.fr/
http://OfficeSystem.Access.free.fr/runtime/
http://users.skynet.be/mpfa/ pour débuter sur le forum

"Joël GARBE" a écrit dans le message de news:
425eb091$0$3120$
Bonsoir,

Je cherche à gagner du temps dans des procédures où il y a 3 niveaux de
boucles inbriquées.

La procédure fonctionne correctement mais est très lente...

A l'intérieur de chaque boucle, j'effectue une requête me permettant de
récupérer des information sur l'élément de la boucle.

La durée d'exécution est très lente et je cherche un moyen de diminuer
cette durée.

Quel peut être ce moyen ?

Une recherche à la place de la requête .? ou autre chose ?

Toutes propositions sera la bienvenue !!!

Vous en remerciant par avance,
--

Bien cordialement,

Joël GARBE
www.joelgarbe.fr

ça va pas aller tout seul.

la différence de matos ? processeur ? disque dur ?
(je t'avais dit, si elle n'est pas trop longue. )
--
@+
Raymond Access MVP
http://OfficeSystem.Access.free.fr/
http://OfficeSystem.Access.free.fr/runtime/
http://users.skynet.be/mpfa/ pour débuter sur le forum

"Joël GARBE" <joel-garbe@wanadoo.fr> a écrit dans le message de news:
425eb4c8$0$19325$8fcfb975@news.wanadoo.fr...

Merci Raymond,

Puisque tu insistes, on peux tenter le coup (je ne risque rien !)
Sur mon poste (avec 1 année soit 12 mois d'étude et 500 employés : environ
5 minutes maxi)
Sur un autre poste et 24 mois d'étude ... 2 heures !!!!!!!!!!!!!!
Pour chaque employé, pour chaque prime, je dois créer des périodes
(renseigner les primes de chaque employé dans chaque période)

sachant que ma base est structurée :
Table Employes
Table SuiviSalarie (Listant toutes les primes de toutes les période de
chaque employé, soit autant d'enregistrement par employé et par période
qu'il y a de primes)
Table SuiviSalarieAnnexe (Listant les informations de base de chaque
employé pour une période donnée : Niveau, Service, Taux d'emploi, etc... 1
enr par employé et par période)
Table Periode ... Listant les différentes périodes (Réel (1) Budget (2)
Forecast (3)
'==================================================== > Private Sub CalculTout()
'Centre névralgique des Budget et Forecast
'Rechercher les enregistrements à modifier dans la table
'SuiviSalarie et SuiviSalarieAnnexe
'Commencer par passer en revue tous les enregistrements du formulaire
Set dbs = CurrentDb

Set rst = dbs.OpenRecordset("Constantes", dbOpenTable)
TxCP = rst.Fields("TauxChargePatronale")

sql = "SELECT Periodes.* " & _
"FROM Periodes " & _
"WHERE (((Periodes.Reel) = " & IIf(Forms("FormMenuPrinc").CACType, 2,
3) & ")) " & _
"ORDER BY Periodes.Annee, Periodes.Mois;"

Set rstPP = dbs.OpenRecordset(sql, dbOpenDynaset)

If rstPP.RecordCount = 0 Then
AfficheMessage "Avant de lancer le calcul, il faut générer les périodes"
& Chr(10) & _
"L'opération est annulée"
GoTo FinProc
End If

'déterminer le premier mois et la première année du Budget / Forecast
PremMoisBF = rstPP.Fields("Mois")
PremAnneeBF = rstPP.Fields("Annee")

'Mais avant : Les constantes...
Set rstE = dbs.OpenRecordset("Constantes", dbOpenTable)
If rstE.RecordCount = 0 Then
AfficheMessage "La base de donnée ne contient aucune Constante !!!" &
Chr(10) & _
"L'opération est annulée"
GoTo FinProc
End If
rstE.MoveFirst
MaxAnc = rstE.Fields("MaxAnciennete")
NivRef = rstE.Fields("NivAnciennete")
MontantAbond = rstE.Fields("Abondement")
MontantInter = rstE.Fields("Interessement")
MontantPart = rstE.Fields("Participation")
MontantPres = rstE.Fields("PrimePresenteisme")

Bonus1 = rstE.Fields("Bonus1")
Bonus2 = rstE.Fields("Bonus2")

'On va passer en revue tous les employés...
'Tous ? pour les embauches vérifier si embauche prévue au budget/Forecast
Set rstE = dbs.OpenRecordset("Employes", dbOpenTable)
If rstE.RecordCount = 0 Then
AfficheMessage "La base de donnée ne contient aucun employé !!!" &
Chr(10) & _
"L'opération est annulée"
GoTo FinProc
End If
rstE.MoveLast
NbEmp = rstE.RecordCount

Set rstR = dbs.OpenRecordset("RqReelComplet", dbOpenDynaset)
If rstR.RecordCount > 0 Then
rstR.MoveLast
NbEnrReel = rstR.RecordCount
Else
AfficheMessage "Pour élaborer le budget ou le forecast, il faut avoir
importé au moins un mois complet" & Chr(10) & _
"C'est à dire les 3 fichiers : effectif, base/ancienneté et Primes" &
Chr(10) & Chr(10) & _
"L'opération est annulée"
GoTo FinProc
End If

'si on commençait pas supprimer toutes les périodes du
'SuiviSalarie et SuiviSalarieAnnexe
'Euh... peut-être pas ici ;-)

'================================================================================ > 'étude : modifier si la période existe déjà !

sql = "DELETE SuiviSalarie.* " & _
"FROM Periodes INNER JOIN SuiviSalarie ON Periodes.N°Periode =
SuiviSalarie.Periode " & _
"WHERE (((Periodes.Reel)= " & IIf(Forms("FormMenuPrinc").CACType, 2, 3) &
"));"

DoCmd.RunSQL sql
'================================================================================== > Set rstP = dbs.OpenRecordset("SuiviSalarie", dbOpenTable)
rstP.MoveLast

'ici le début de la barre de progression
NbCycle = NbEmp
Pbar.Ouvrir
Forms("frmProgressBis").Caption = "MAJ Employé : " & rstE.Fields("Nom") &
" " & rstE.Fields("PreNom")

CompteurBar = NbCycle / 100
RefCompteur = 0

Set rstSuiviS = dbs.OpenRecordset("SuiviSalarie", dbOpenTable)
Set rstSuiviAnS = dbs.OpenRecordset("SuiviSalarieAnnexe", dbOpenTable)

rstE.MoveFirst
'====================================== > Do

Forms("frmProgressBis").Caption = "MAJ Employé : " & rstE.Fields("Nom") &
" " & rstE.Fields("Prenom")

RefCompteur = RefCompteur + 1
If RefCompteur = CompteurBar Then
RefCompteur = 0
Pbar.Avancer 1
End If

'Employé par employé
NumEmp = rstE.Fields("N°Salarie")
On Error Resume Next
MoisEmb = Month(rstE.Fields("DateEmbauche"))
AnneeEmb = Year(rstE.Fields("DateEmbauche"))
On Error GoTo 0

'déterminer les informations annexes de base concernant l'employé :
sql = "SELECT SuiviSalarieAnnexe.Periode, Niveaux.Niveau,
SuiviSalarieAnnexe.Salarie, Niveaux.N°Niveau, SuiviSalarieAnnexe.CB,
SuiviSalarieAnnexe.Statut, SuiviSalarieAnnexe.Taux,
SuiviSalarieAnnexe.TypeContrat, Periodes.Reel " & _
"FROM Periodes INNER JOIN (Niveaux INNER JOIN SuiviSalarieAnnexe ON
Niveaux.N°Niveau = SuiviSalarieAnnexe.Niveau) ON Periodes.N°Periode =
SuiviSalarieAnnexe.Periode " & _
"WHERE (((SuiviSalarieAnnexe.Salarie) = " & NumEmp & ") And
((Periodes.Reel) = 1)) " & _
"ORDER BY SuiviSalarieAnnexe.Periode DESC;"

Set rstEmpAn = dbs.OpenRecordset(sql, dbOpenDynaset)

'===================================================== >
KelTaux = 1
On Error Resume Next
'Par employé et par période...
NivEmp = rstEmpAn.Fields("Niveau")
NumNiv = rstEmpAn.Fields("N°Niveau")
KelNiv = CInt(Left(rstEmpAn.Fields("Niveau"), 1))
KelCB = rstEmpAn.Fields("CB")
KelStatut = rstEmpAn.Fields("Statut")
KelTaux = rstEmpAn.Fields("Taux")
KelContrat = rstEmpAn.Fields("TypeContrat")

On Error GoTo 0
'===================================================== >
'Prime par prime de l'employé des fichiers réels
sql = "SELECT Primes.N°Prime, SuiviSalarie.Salarie, Periodes.Reel " & _
"FROM Periodes INNER JOIN (Primes INNER JOIN SuiviSalarie ON
Primes.N°Prime = SuiviSalarie.Prime) ON Periodes.N°Periode =
SuiviSalarie.Periode " & _
"GROUP BY Primes.N°Prime, SuiviSalarie.Salarie, Periodes.Reel " & _
"HAVING (((SuiviSalarie.Salarie)=" & NumEmp & " AND
((Periodes.Reel)=1)));"

Set rstP = dbs.OpenRecordset(sql, dbOpenDynaset)
If rstP.RecordCount > 0 Then 'Employé réel sinon embauche prévue
rstP.MoveFirst
'============================================= > CompteurPrime = 0

Do
CompteurPrime = CompteurPrime + 1
'Prime par prime
NumP = rstP.Fields("N°Prime")
'CodeP = rstP.Fields("CodePrime")
Dim rstPr As DAO.Recordset
sql = "SELECT Primes.* FROM Primes WHERE Primes.N°Prime = " & NumP &
";"
Set rstPr = dbs.OpenRecordset(sql, dbOpenDynaset)
rstPr.MoveFirst
CodeP = rstPr.Fields("CodePrime")
rstPr.Close

Set rstPr = Nothing

sql = "SELECT Primes.N°Prime, SuiviSalarie.Salarie,
SuiviSalarie.Periode, SuiviSalarie.Montant, Periodes.Annee, Periodes.Mois
" & _
"FROM Periodes INNER JOIN (Primes INNER JOIN SuiviSalarie ON
Primes.N°Prime = SuiviSalarie.Prime) ON Periodes.N°Periode =
SuiviSalarie.Periode " & _
"WHERE (((Primes.N°Prime)=" & NumP & ") AND
((SuiviSalarie.Salarie)=" & NumEmp & ")) " & _
"ORDER BY Periodes.Annee DESC , Periodes.Mois DESC;"
'Commencer par déterminer les montants de référence pour chacune des
primes de l'employé
'La moyenne des 5 périodes précédentes !
Set rstPRE = dbs.OpenRecordset(sql, dbOpenDynaset)
rstPRE.MoveFirst
i = 0
MontantRef = 0
Do
MontantRef = rstPRE.Fields("Montant")
If (rstPRE.Fields("Mois") <= PremMoisBF And rstPRE.Fields("Annee")
= PremAnneeBF) Or rstPRE.Fields("Annee") < PremAnneeBF Then
ReDim Preserve MontantPEmp(i)
MontantPEmp(i) = rstPRE.Fields("Montant")
i = i + 1
End If
rstPRE.MoveNext
Loop Until rstPRE.EOF Or i = 5

If i > 0 Then
'il y a eu de période réelle antérieure à la première période du
budget/Forecast trouvée...
MontantRef = 0
'déterminer le montant de référence pour cette prime de cet
employé...
For i = LBound(MontantPEmp()) To UBound(MontantPEmp())
MontantRef = MontantRef + MontantPEmp(i)
Next
MontantRef = MontantRef / (UBound(MontantPEmp()) + 1)
End If
'Injecter ce montant dans le budget / Forecast...
'Attention aux augmentations...
'Déterminer déjà le niveau de l'employé

'Passer maintenant en revue toutes les périodes du formulaire...

rstPP.MoveFirst
CompteurPer = 0
Do
CompteurPer = CompteurPer + 1
'La période existe, c'est obligatoire...
KelPer = rstPP.Fields("N°Periode")

KelMois = rstPP.Fields("Mois")
KelAnnee = rstPP.Fields("Annee")

Select Case KelNiv
Case Is <= 3
If Left(NivEmp, 2) <> "10" Then
MontantRef = MontantRef * (1 + rstPP.Fields("AugmenT1"))
End If
Case 4 To 6
MontantRef = MontantRef * (1 + rstPP.Fields("AugmenT2"))
Case Else
MontantRef = MontantRef * (1 + rstPP.Fields("AugmenT3"))
End Select

If NumP = 2 Then 'Prime d'ancienneté
If KelNiv <= NivRef And Right(NivEmp, 2) <> "6B" And Left(NivEmp,
2) <> "10" Then
sql = "SELECT Primes.N°Prime, SuiviSalarie.Salarie,
Periodes.Reel, SuiviSalarie.Montant, Periodes.N°Periode, Primes.CP " & _
"FROM Periodes INNER JOIN (Primes INNER JOIN SuiviSalarie ON
Primes.N°Prime = SuiviSalarie.Prime) ON Periodes.N°Periode =
SuiviSalarie.Periode " & _
"WHERE (SuiviSalarie.Salarie=" & NumEmp & ") AND
(Periodes.N°Periode=" & KelPer & ") AND (Periodes.Reel=" &
IIf(Forms("FormMenuPrinc").CACType, 2, 3) & ") AND N°Prime=1;"
Dim rsBaseEmp As DAO.Recordset

Set rsBaseEmp = dbs.OpenRecordset(sql, dbOpenDynaset)
rsBaseEmp.MoveFirst
BaseEmp = rsBaseEmp.Fields("Montant")
MontantRef = BaseEmp * (IIf(MaxAnc / 100 > Int(((KelAnnee -
AnneeEmb) * 12 + KelMois - MoisEmb - 1) / 12) / 100, Int(((KelAnnee -
AnneeEmb) * 12 + KelMois - MoisEmb - 1) / 12) / 100, MaxAnc / 100))
End If

'Gratification d'ancienneté 'annulé sur demande de DDL !
GoTo PassGrat
If (KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 120 Then
MontantRef = (MontantRef + BaseEmp) * 0.5 + MontantRef

End If

If (KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 180 Then
MontantRef = (MontantRef + BaseEmp) * 0.75 + MontantRef

End If

If (KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 240 Or _
(KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 300 Or _
(KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 360 Then
MontantRef = (MontantRef + BaseEmp) + MontantRef

End If

If (KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 420 Or _
(KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 480 Then
MontantRef = (MontantRef + BaseEmp) * 2 + MontantRef

End If
PassGrat:

End If
If CodeP = "2042" Or CodeP = "2044" Or _
CodeP = "2048" Or CodeP = "2058" Or CodeP = "9BAP" Or _
CodeP = "/101" Then
Else
Dim rsCP As DAO.Recordset
Set rsCP = dbs.OpenRecordset("SELECT Primes.* FROM Primes WHERE
Primes.N°Prime = " & NumP & ";")
rsCP.MoveFirst

CPOK = rsCP.Fields("CP")

If NumP = 3 Then 'Abondement
MontantRef = MontantAbond
End If
If NumP = 4 Then 'Intéressement
MontantRef = MontantInter
End If
If NumP = 5 Then 'Participation
MontantRef = MontantPart
End If
If NumP = 6 Then 'Présentéïsme
MontantRef = MontantPres
End If
If NumP = 7 Then 'Bonus Or CodeP = "9106"
'tous les mois !
'Niveau 7 et 8 : 10% du salaire annuel
If KelNiv = 7 Or KelNiv = 8 Then
MontantRef = BaseEmp * 13 * 0.1 / 12
End If
'niveau 9 : 15% ou 20% selon les cas (20% pour 2 personnes)
If KelNiv = 9 Then
If NumEmp = Bonus1 Or NumEmp = Bonus2 Then
MontantRef = BaseEmp * 13 * 0.2 / 12
Else
MontantRef = BaseEmp * 13 * 0.15 / 12
End If
End If
End If

rstSuiviS.AddNew
rstSuiviS.Fields("Salarie") = NumEmp
rstSuiviS.Fields("Periode") = KelPer
rstSuiviS.Fields("Prime") = NumP
rstSuiviS.Fields("Montant") = MontantRef
If NumP > 0 And CPOK Then
rstSuiviS.Fields("MontantCP") = rstSuiviS.Fields("Montant") *
TxCP
Else
rstSuiviS.Fields("MontantCP") = 0
End If
rstSuiviS.Update
End If
'============================================= > 'La suite n'est à faire qu'une seule fois !!!
If CompteurPrime = 1 Then
'KelTaux = 1

'Par employé et par période...
Dim rstCont As DAO.Recordset
Dim sqlCont As String
sqlCont = "SELECT SuiviSalarieAnnexe.* FROM SuiviSalarieAnnexe "
& _
"WHERE SuiviSalarieAnnexe.Salarie = " & NumEmp & " AND
SuiviSalarieAnnexe.Periode = " & KelPer & ";"

Set rstCont = dbs.OpenRecordset(sqlCont, dbOpenDynaset)
If rstCont.RecordCount <= 0 Then

rstSuiviAnS.AddNew
rstSuiviAnS.Fields("Salarie") = NumEmp
rstSuiviAnS.Fields("Periode") = KelPer
rstSuiviAnS.Fields("CB") = KelCB
rstSuiviAnS.Fields("Niveau") = NumNiv
rstSuiviAnS.Fields("Statut") = KelStatut
rstSuiviAnS.Fields("Taux") = KelTaux
rstSuiviAnS.Fields("TypeContrat") = KelContrat

rstSuiviAnS.Update
End If
End If
'=============================================== >
rstPP.MoveNext
Loop Until rstPP.EOF

rstP.MoveNext
Loop Until rstP.EOF

Else
'il s'agit d'un employé prévu!!!!
'à traiter différemment !
End If

rstE.MoveNext
Loop Until rstE.EOF
Pbar.Fermer
FinProc:
On Error Resume Next
rstE.Close
rstR.Close
rstP.Close
rstCont.Close
rstPRE.Close
rstEmpAn.Close
rstSuiviS.Close
rstSuiviAnS.Close
Set rstSuiviAnS = Nothing
Set rstSuiviS = Nothing
Set rstEmpAn = Nothing
Set rstPRE = Nothing
Set rstP = Nothing
Set rstCont = Nothing
Set rstE = Nothing
Set rstR = Nothing
Set dbs = Nothing
On Error GoTo 0
End Sub

'==================================================== >
--

Bien cordialement,

Joël GARBE
www.joelgarbe.fr
"Raymond [mvp]" <XYZ.officesystem.access@free.fr> a écrit dans le message
de news: OdWs6zRQFHA.1268@TK2MSFTNGP14.phx.gbl...

Bonsoir Joël.

elle est longue ta boucle ? si non affiche la ici.

est-ce la boucle ou la requête qui est longue ? quel est l'ordre d'idée
du temps nécessaire ?

--
@+
Raymond Access MVP
http://OfficeSystem.Access.free.fr/
http://OfficeSystem.Access.free.fr/runtime/
http://users.skynet.be/mpfa/ pour débuter sur le forum

"Joël GARBE" <joel-garbe@wanadoo.fr> a écrit dans le message de news:
425eb091$0$3120$8fcfb975@news.wanadoo.fr...

Bonsoir,

Je cherche à gagner du temps dans des procédures où il y a 3 niveaux de
boucles inbriquées.

La procédure fonctionne correctement mais est très lente...

A l'intérieur de chaque boucle, j'effectue une requête me permettant de
récupérer des information sur l'élément de la boucle.

La durée d'exécution est très lente et je cherche un moyen de diminuer
cette durée.

Quel peut être ce moyen ?

Une recherche à la place de la requête .? ou autre chose ?

Toutes propositions sera la bienvenue !!!

Vous en remerciant par avance,
--

Bien cordialement,

Joël GARBE
www.joelgarbe.fr

Vous avez filtré cet utilisateur ! Consultez son message

ça va pas aller tout seul.

la différence de matos ? processeur ? disque dur ?
(je t'avais dit, si elle n'est pas trop longue. )
--
@+
Raymond Access MVP
http://OfficeSystem.Access.free.fr/
http://OfficeSystem.Access.free.fr/runtime/
http://users.skynet.be/mpfa/ pour débuter sur le forum

"Joël GARBE" a écrit dans le message de news:
425eb4c8$0$19325$

Merci Raymond,

Puisque tu insistes, on peux tenter le coup (je ne risque rien !)
Sur mon poste (avec 1 année soit 12 mois d'étude et 500 employés : environ
5 minutes maxi)
Sur un autre poste et 24 mois d'étude ... 2 heures !!!!!!!!!!!!!!
Pour chaque employé, pour chaque prime, je dois créer des périodes
(renseigner les primes de chaque employé dans chaque période)

sachant que ma base est structurée :
Table Employes
Table SuiviSalarie (Listant toutes les primes de toutes les période de
chaque employé, soit autant d'enregistrement par employé et par période
qu'il y a de primes)
Table SuiviSalarieAnnexe (Listant les informations de base de chaque
employé pour une période donnée : Niveau, Service, Taux d'emploi, etc... 1
enr par employé et par période)
Table Periode ... Listant les différentes périodes (Réel (1) Budget (2)
Forecast (3)
'==================================================== > Private Sub CalculTout()
'Centre névralgique des Budget et Forecast
'Rechercher les enregistrements à modifier dans la table
'SuiviSalarie et SuiviSalarieAnnexe
'Commencer par passer en revue tous les enregistrements du formulaire
Set dbs = CurrentDb

Set rst = dbs.OpenRecordset("Constantes", dbOpenTable)
TxCP = rst.Fields("TauxChargePatronale")

sql = "SELECT Periodes.* " & _
"FROM Periodes " & _
"WHERE (((Periodes.Reel) = " & IIf(Forms("FormMenuPrinc").CACType, 2,
3) & ")) " & _
"ORDER BY Periodes.Annee, Periodes.Mois;"

Set rstPP = dbs.OpenRecordset(sql, dbOpenDynaset)

If rstPP.RecordCount = 0 Then
AfficheMessage "Avant de lancer le calcul, il faut générer les périodes"
& Chr(10) & _
"L'opération est annulée"
GoTo FinProc
End If

'déterminer le premier mois et la première année du Budget / Forecast
PremMoisBF = rstPP.Fields("Mois")
PremAnneeBF = rstPP.Fields("Annee")

'Mais avant : Les constantes...
Set rstE = dbs.OpenRecordset("Constantes", dbOpenTable)
If rstE.RecordCount = 0 Then
AfficheMessage "La base de donnée ne contient aucune Constante !!!" &
Chr(10) & _
"L'opération est annulée"
GoTo FinProc
End If
rstE.MoveFirst
MaxAnc = rstE.Fields("MaxAnciennete")
NivRef = rstE.Fields("NivAnciennete")
MontantAbond = rstE.Fields("Abondement")
MontantInter = rstE.Fields("Interessement")
MontantPart = rstE.Fields("Participation")
MontantPres = rstE.Fields("PrimePresenteisme")

Bonus1 = rstE.Fields("Bonus1")
Bonus2 = rstE.Fields("Bonus2")

'On va passer en revue tous les employés...
'Tous ? pour les embauches vérifier si embauche prévue au budget/Forecast
Set rstE = dbs.OpenRecordset("Employes", dbOpenTable)
If rstE.RecordCount = 0 Then
AfficheMessage "La base de donnée ne contient aucun employé !!!" &
Chr(10) & _
"L'opération est annulée"
GoTo FinProc
End If
rstE.MoveLast
NbEmp = rstE.RecordCount

Set rstR = dbs.OpenRecordset("RqReelComplet", dbOpenDynaset)
If rstR.RecordCount > 0 Then
rstR.MoveLast
NbEnrReel = rstR.RecordCount
Else
AfficheMessage "Pour élaborer le budget ou le forecast, il faut avoir
importé au moins un mois complet" & Chr(10) & _
"C'est à dire les 3 fichiers : effectif, base/ancienneté et Primes" &
Chr(10) & Chr(10) & _
"L'opération est annulée"
GoTo FinProc
End If

'si on commençait pas supprimer toutes les périodes du
'SuiviSalarie et SuiviSalarieAnnexe
'Euh... peut-être pas ici ;-)

'================================================================================ > 'étude : modifier si la période existe déjà !

sql = "DELETE SuiviSalarie.* " & _
"FROM Periodes INNER JOIN SuiviSalarie ON Periodes.N°Periode =
SuiviSalarie.Periode " & _
"WHERE (((Periodes.Reel)= " & IIf(Forms("FormMenuPrinc").CACType, 2, 3) &
"));"

DoCmd.RunSQL sql
'================================================================================== > Set rstP = dbs.OpenRecordset("SuiviSalarie", dbOpenTable)
rstP.MoveLast

'ici le début de la barre de progression
NbCycle = NbEmp
Pbar.Ouvrir
Forms("frmProgressBis").Caption = "MAJ Employé : " & rstE.Fields("Nom") &
" " & rstE.Fields("PreNom")

CompteurBar = NbCycle / 100
RefCompteur = 0

Set rstSuiviS = dbs.OpenRecordset("SuiviSalarie", dbOpenTable)
Set rstSuiviAnS = dbs.OpenRecordset("SuiviSalarieAnnexe", dbOpenTable)

rstE.MoveFirst
'====================================== > Do

Forms("frmProgressBis").Caption = "MAJ Employé : " & rstE.Fields("Nom") &
" " & rstE.Fields("Prenom")

RefCompteur = RefCompteur + 1
If RefCompteur = CompteurBar Then
RefCompteur = 0
Pbar.Avancer 1
End If

'Employé par employé
NumEmp = rstE.Fields("N°Salarie")
On Error Resume Next
MoisEmb = Month(rstE.Fields("DateEmbauche"))
AnneeEmb = Year(rstE.Fields("DateEmbauche"))
On Error GoTo 0

'déterminer les informations annexes de base concernant l'employé :
sql = "SELECT SuiviSalarieAnnexe.Periode, Niveaux.Niveau,
SuiviSalarieAnnexe.Salarie, Niveaux.N°Niveau, SuiviSalarieAnnexe.CB,
SuiviSalarieAnnexe.Statut, SuiviSalarieAnnexe.Taux,
SuiviSalarieAnnexe.TypeContrat, Periodes.Reel " & _
"FROM Periodes INNER JOIN (Niveaux INNER JOIN SuiviSalarieAnnexe ON
Niveaux.N°Niveau = SuiviSalarieAnnexe.Niveau) ON Periodes.N°Periode =
SuiviSalarieAnnexe.Periode " & _
"WHERE (((SuiviSalarieAnnexe.Salarie) = " & NumEmp & ") And
((Periodes.Reel) = 1)) " & _
"ORDER BY SuiviSalarieAnnexe.Periode DESC;"

Set rstEmpAn = dbs.OpenRecordset(sql, dbOpenDynaset)

'===================================================== >
KelTaux = 1
On Error Resume Next
'Par employé et par période...
NivEmp = rstEmpAn.Fields("Niveau")
NumNiv = rstEmpAn.Fields("N°Niveau")
KelNiv = CInt(Left(rstEmpAn.Fields("Niveau"), 1))
KelCB = rstEmpAn.Fields("CB")
KelStatut = rstEmpAn.Fields("Statut")
KelTaux = rstEmpAn.Fields("Taux")
KelContrat = rstEmpAn.Fields("TypeContrat")

On Error GoTo 0
'===================================================== >
'Prime par prime de l'employé des fichiers réels
sql = "SELECT Primes.N°Prime, SuiviSalarie.Salarie, Periodes.Reel " & _
"FROM Periodes INNER JOIN (Primes INNER JOIN SuiviSalarie ON
Primes.N°Prime = SuiviSalarie.Prime) ON Periodes.N°Periode =
SuiviSalarie.Periode " & _
"GROUP BY Primes.N°Prime, SuiviSalarie.Salarie, Periodes.Reel " & _
"HAVING (((SuiviSalarie.Salarie)=" & NumEmp & " AND
((Periodes.Reel)=1)));"

Set rstP = dbs.OpenRecordset(sql, dbOpenDynaset)
If rstP.RecordCount > 0 Then 'Employé réel sinon embauche prévue
rstP.MoveFirst
'============================================= > CompteurPrime = 0

Do
CompteurPrime = CompteurPrime + 1
'Prime par prime
NumP = rstP.Fields("N°Prime")
'CodeP = rstP.Fields("CodePrime")
Dim rstPr As DAO.Recordset
sql = "SELECT Primes.* FROM Primes WHERE Primes.N°Prime = " & NumP &
";"
Set rstPr = dbs.OpenRecordset(sql, dbOpenDynaset)
rstPr.MoveFirst
CodeP = rstPr.Fields("CodePrime")
rstPr.Close

Set rstPr = Nothing

sql = "SELECT Primes.N°Prime, SuiviSalarie.Salarie,
SuiviSalarie.Periode, SuiviSalarie.Montant, Periodes.Annee, Periodes.Mois
" & _
"FROM Periodes INNER JOIN (Primes INNER JOIN SuiviSalarie ON
Primes.N°Prime = SuiviSalarie.Prime) ON Periodes.N°Periode =
SuiviSalarie.Periode " & _
"WHERE (((Primes.N°Prime)=" & NumP & ") AND
((SuiviSalarie.Salarie)=" & NumEmp & ")) " & _
"ORDER BY Periodes.Annee DESC , Periodes.Mois DESC;"
'Commencer par déterminer les montants de référence pour chacune des
primes de l'employé
'La moyenne des 5 périodes précédentes !
Set rstPRE = dbs.OpenRecordset(sql, dbOpenDynaset)
rstPRE.MoveFirst
i = 0
MontantRef = 0
Do
MontantRef = rstPRE.Fields("Montant")
If (rstPRE.Fields("Mois") <= PremMoisBF And rstPRE.Fields("Annee")
= PremAnneeBF) Or rstPRE.Fields("Annee") < PremAnneeBF Then
ReDim Preserve MontantPEmp(i)
MontantPEmp(i) = rstPRE.Fields("Montant")
i = i + 1
End If
rstPRE.MoveNext
Loop Until rstPRE.EOF Or i = 5

If i > 0 Then
'il y a eu de période réelle antérieure à la première période du
budget/Forecast trouvée...
MontantRef = 0
'déterminer le montant de référence pour cette prime de cet
employé...
For i = LBound(MontantPEmp()) To UBound(MontantPEmp())
MontantRef = MontantRef + MontantPEmp(i)
Next
MontantRef = MontantRef / (UBound(MontantPEmp()) + 1)
End If
'Injecter ce montant dans le budget / Forecast...
'Attention aux augmentations...
'Déterminer déjà le niveau de l'employé

'Passer maintenant en revue toutes les périodes du formulaire...

rstPP.MoveFirst
CompteurPer = 0
Do
CompteurPer = CompteurPer + 1
'La période existe, c'est obligatoire...
KelPer = rstPP.Fields("N°Periode")

KelMois = rstPP.Fields("Mois")
KelAnnee = rstPP.Fields("Annee")

Select Case KelNiv
Case Is <= 3
If Left(NivEmp, 2) <> "10" Then
MontantRef = MontantRef * (1 + rstPP.Fields("AugmenT1"))
End If
Case 4 To 6
MontantRef = MontantRef * (1 + rstPP.Fields("AugmenT2"))
Case Else
MontantRef = MontantRef * (1 + rstPP.Fields("AugmenT3"))
End Select

If NumP = 2 Then 'Prime d'ancienneté
If KelNiv <= NivRef And Right(NivEmp, 2) <> "6B" And Left(NivEmp,
2) <> "10" Then
sql = "SELECT Primes.N°Prime, SuiviSalarie.Salarie,
Periodes.Reel, SuiviSalarie.Montant, Periodes.N°Periode, Primes.CP " & _
"FROM Periodes INNER JOIN (Primes INNER JOIN SuiviSalarie ON
Primes.N°Prime = SuiviSalarie.Prime) ON Periodes.N°Periode =
SuiviSalarie.Periode " & _
"WHERE (SuiviSalarie.Salarie=" & NumEmp & ") AND
(Periodes.N°Periode=" & KelPer & ") AND (Periodes.Reel=" &
IIf(Forms("FormMenuPrinc").CACType, 2, 3) & ") AND N°Prime=1;"
Dim rsBaseEmp As DAO.Recordset

Set rsBaseEmp = dbs.OpenRecordset(sql, dbOpenDynaset)
rsBaseEmp.MoveFirst
BaseEmp = rsBaseEmp.Fields("Montant")
MontantRef = BaseEmp * (IIf(MaxAnc / 100 > Int(((KelAnnee -
AnneeEmb) * 12 + KelMois - MoisEmb - 1) / 12) / 100, Int(((KelAnnee -
AnneeEmb) * 12 + KelMois - MoisEmb - 1) / 12) / 100, MaxAnc / 100))
End If

'Gratification d'ancienneté 'annulé sur demande de DDL !
GoTo PassGrat
If (KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 120 Then
MontantRef = (MontantRef + BaseEmp) * 0.5 + MontantRef

End If

If (KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 180 Then
MontantRef = (MontantRef + BaseEmp) * 0.75 + MontantRef

End If

If (KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 240 Or _
(KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 300 Or _
(KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 360 Then
MontantRef = (MontantRef + BaseEmp) + MontantRef

End If

If (KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 420 Or _
(KelAnnee - AnneeEmb) * 12 + KelMois - MoisEmb = 480 Then
MontantRef = (MontantRef + BaseEmp) * 2 + MontantRef

End If
PassGrat:

End If
If CodeP = "2042" Or CodeP = "2044" Or _
CodeP = "2048" Or CodeP = "2058" Or CodeP = "9BAP" Or _
CodeP = "/101" Then
Else
Dim rsCP As DAO.Recordset
Set rsCP = dbs.OpenRecordset("SELECT Primes.* FROM Primes WHERE
Primes.N°Prime = " & NumP & ";")
rsCP.MoveFirst

CPOK = rsCP.Fields("CP")

If NumP = 3 Then 'Abondement
MontantRef = MontantAbond
End If
If NumP = 4 Then 'Intéressement
MontantRef = MontantInter
End If
If NumP = 5 Then 'Participation
MontantRef = MontantPart
End If
If NumP = 6 Then 'Présentéïsme
MontantRef = MontantPres
End If
If NumP = 7 Then 'Bonus Or CodeP = "9106"
'tous les mois !
'Niveau 7 et 8 : 10% du salaire annuel
If KelNiv = 7 Or KelNiv = 8 Then
MontantRef = BaseEmp * 13 * 0.1 / 12
End If
'niveau 9 : 15% ou 20% selon les cas (20% pour 2 personnes)
If KelNiv = 9 Then
If NumEmp = Bonus1 Or NumEmp = Bonus2 Then
MontantRef = BaseEmp * 13 * 0.2 / 12
Else
MontantRef = BaseEmp * 13 * 0.15 / 12
End If
End If
End If

rstSuiviS.AddNew
rstSuiviS.Fields("Salarie") = NumEmp
rstSuiviS.Fields("Periode") = KelPer
rstSuiviS.Fields("Prime") = NumP
rstSuiviS.Fields("Montant") = MontantRef
If NumP > 0 And CPOK Then
rstSuiviS.Fields("MontantCP") = rstSuiviS.Fields("Montant") *
TxCP
Else
rstSuiviS.Fields("MontantCP") = 0
End If
rstSuiviS.Update
End If
'============================================= > 'La suite n'est à faire qu'une seule fois !!!
If CompteurPrime = 1 Then
'KelTaux = 1

'Par employé et par période...
Dim rstCont As DAO.Recordset
Dim sqlCont As String
sqlCont = "SELECT SuiviSalarieAnnexe.* FROM SuiviSalarieAnnexe "
& _
"WHERE SuiviSalarieAnnexe.Salarie = " & NumEmp & " AND
SuiviSalarieAnnexe.Periode = " & KelPer & ";"

Set rstCont = dbs.OpenRecordset(sqlCont, dbOpenDynaset)
If rstCont.RecordCount <= 0 Then

rstSuiviAnS.AddNew
rstSuiviAnS.Fields("Salarie") = NumEmp
rstSuiviAnS.Fields("Periode") = KelPer
rstSuiviAnS.Fields("CB") = KelCB
rstSuiviAnS.Fields("Niveau") = NumNiv
rstSuiviAnS.Fields("Statut") = KelStatut
rstSuiviAnS.Fields("Taux") = KelTaux
rstSuiviAnS.Fields("TypeContrat") = KelContrat

rstSuiviAnS.Update
End If
End If
'=============================================== >
rstPP.MoveNext
Loop Until rstPP.EOF

rstP.MoveNext
Loop Until rstP.EOF

Else
'il s'agit d'un employé prévu!!!!
'à traiter différemment !
End If

rstE.MoveNext
Loop Until rstE.EOF
Pbar.Fermer
FinProc:
On Error Resume Next
rstE.Close
rstR.Close
rstP.Close
rstCont.Close
rstPRE.Close
rstEmpAn.Close
rstSuiviS.Close
rstSuiviAnS.Close
Set rstSuiviAnS = Nothing
Set rstSuiviS = Nothing
Set rstEmpAn = Nothing
Set rstPRE = Nothing
Set rstP = Nothing
Set rstCont = Nothing
Set rstE = Nothing
Set rstR = Nothing
Set dbs = Nothing
On Error GoTo 0
End Sub

'==================================================== >
--

Bien cordialement,

Joël GARBE
www.joelgarbe.fr
"Raymond [mvp]" a écrit dans le message
de news:
Bonsoir Joël.

elle est longue ta boucle ? si non affiche la ici.

est-ce la boucle ou la requête qui est longue ? quel est l'ordre d'idée
du temps nécessaire ?

--
@+
Raymond Access MVP
http://OfficeSystem.Access.free.fr/
http://OfficeSystem.Access.free.fr/runtime/
http://users.skynet.be/mpfa/ pour débuter sur le forum

"Joël GARBE" a écrit dans le message de news:
425eb091$0$3120$
Bonsoir,

Je cherche à gagner du temps dans des procédures où il y a 3 niveaux de
boucles inbriquées.

La procédure fonctionne correctement mais est très lente...

A l'intérieur de chaque boucle, j'effectue une requête me permettant de
récupérer des information sur l'élément de la boucle.

La durée d'exécution est très lente et je cherche un moyen de diminuer
cette durée.

Quel peut être ce moyen ?

Une recherche à la place de la requête .? ou autre chose ?

Toutes propositions sera la bienvenue !!!

Vous en remerciant par avance,
--

Bien cordialement,

Joël GARBE
www.joelgarbe.fr

Joël GARBE

14/04/2005 à 20:54

Bein oui, je sais, tu l'avais dit, mais j'ai tenté le coup.

Je n'en voudrais à personne si je n'ai pas de réponse précise, simplement
des orientations m'aideraient..

Par rapport au matos, globalement, c'est équivalent, puisque j'avais essayé
avec les mêmes données, pour un résultat équivalent...

Il semble vraiment que ce soit l'augmentation du nombre de périodes qui
augmente la durée du processus... de façon exponentielle

c'est à dire cette partie : 'j'ai supprimé le message source pour réduire la
longeur du message)
=================================================
Do
CompteurPer = CompteurPer + 1
'La période existe, c'est obligatoire...
KelPer = rstPP.Fields("N°Periode")

KelMois = rstPP.Fields("Mois")
KelAnnee = rstPP.Fields("Annee")

Select Case KelNiv
Case Is <= 3
If Left(NivEmp, 2) <> "10" Then
MontantRef = MontantRef * (1 + rstPP.Fields("AugmenT1"))
End If
Case 4 To 6
MontantRef = MontantRef * (1 + rstPP.Fields("AugmenT2"))
Case Else
MontantRef = MontantRef * (1 + rstPP.Fields("AugmenT3"))
End Select

If NumP = 2 Then 'Prime d'ancienneté
If KelNiv <= NivRef And Right(NivEmp, 2) <> "6B" And Left(NivEmp,
2) <> "10" Then
sql = "SELECT Primes.N°Prime, SuiviSalarie.Salarie,
Periodes.Reel, SuiviSalarie.Montant, Periodes.N°Periode, Primes.CP " & _
"FROM Periodes INNER JOIN (Primes INNER JOIN SuiviSalarie ON
Primes.N°Prime = SuiviSalarie.Prime) ON Periodes.N°Periode =
SuiviSalarie.Periode " & _
"WHERE (SuiviSalarie.Salarie=" & NumEmp & ") AND
(Periodes.N°Periode=" & KelPer & ") AND (Periodes.Reel=" &
IIf(Forms("FormMenuPrinc").CACType, 2, 3) & ") AND N°Prime=1;"
Dim rsBaseEmp As DAO.Recordset

Set rsBaseEmp = dbs.OpenRecordset(sql, dbOpenDynaset)
rsBaseEmp.MoveFirst
BaseEmp = rsBaseEmp.Fields("Montant")
MontantRef = BaseEmp * (IIf(MaxAnc / 100 > Int(((KelAnnee -
AnneeEmb) * 12 + KelMois - MoisEmb - 1) / 12) / 100, Int(((KelAnnee -
AnneeEmb) * 12 + KelMois - MoisEmb - 1) / 12) / 100, MaxAnc / 100))
End If

'Gratification d'ancienneté 'annulé sur demande de DDL !

End If
If CodeP = "2042" Or CodeP = "2044" Or _
CodeP = "2048" Or CodeP = "2058" Or CodeP = "9BAP" Or _
CodeP = "/101" Then
Else
Dim rsCP As DAO.Recordset
Set rsCP = dbs.OpenRecordset("SELECT Primes.* FROM Primes WHERE
Primes.N°Prime = " & NumP & ";")
rsCP.MoveFirst

CPOK = rsCP.Fields("CP")

If NumP = 3 Then 'Abondement
MontantRef = MontantAbond
End If
If NumP = 4 Then 'Intéressement
MontantRef = MontantInter
End If
If NumP = 5 Then 'Participation
MontantRef = MontantPart
End If
If NumP = 6 Then 'Présentéïsme
MontantRef = MontantPres
End If
If NumP = 7 Then 'Bonus Or CodeP = "9106"
'tous les mois !
'Niveau 7 et 8 : 10% du salaire annuel
If KelNiv = 7 Or KelNiv = 8 Then
MontantRef = BaseEmp * 13 * 0.1 / 12
End If
'niveau 9 : 15% ou 20% selon les cas (20% pour 2 personnes)
If KelNiv = 9 Then
If NumEmp = Bonus1 Or NumEmp = Bonus2 Then
MontantRef = BaseEmp * 13 * 0.2 / 12
Else
MontantRef = BaseEmp * 13 * 0.15 / 12
End If
End If
End If

rstSuiviS.AddNew
rstSuiviS.Fields("Salarie") = NumEmp
rstSuiviS.Fields("Periode") = KelPer
rstSuiviS.Fields("Prime") = NumP
rstSuiviS.Fields("Montant") = MontantRef
If NumP > 0 And CPOK Then
rstSuiviS.Fields("MontantCP") = rstSuiviS.Fields("Montant") *
TxCP
Else
rstSuiviS.Fields("MontantCP") = 0
End If
rstSuiviS.Update
End If
'============================================= 'La suite n'est à faire qu'une seule fois !!!
If CompteurPrime = 1 Then
'KelTaux = 1

'Par employé et par période...
Dim rstCont As DAO.Recordset
Dim sqlCont As String
sqlCont = "SELECT SuiviSalarieAnnexe.* FROM SuiviSalarieAnnexe " &
_
"WHERE SuiviSalarieAnnexe.Salarie = " & NumEmp & " AND
SuiviSalarieAnnexe.Periode = " & KelPer & ";"

Set rstCont = dbs.OpenRecordset(sqlCont, dbOpenDynaset)
If rstCont.RecordCount <= 0 Then

rstSuiviAnS.AddNew
rstSuiviAnS.Fields("Salarie") = NumEmp
rstSuiviAnS.Fields("Periode") = KelPer
rstSuiviAnS.Fields("CB") = KelCB
rstSuiviAnS.Fields("Niveau") = NumNiv
rstSuiviAnS.Fields("Statut") = KelStatut
rstSuiviAnS.Fields("Taux") = KelTaux
rstSuiviAnS.Fields("TypeContrat") = KelContrat

rstSuiviAnS.Update
End If
End If
'===============================================
rstPP.MoveNext
Loop Until rstPP.EOF

=================================================
--

Bien cordialement,

Joël GARBE
www.joelgarbe.fr

Vous avez filtré cet utilisateur ! Consultez son message

Bein oui, je sais, tu l'avais dit, mais j'ai tenté le coup.

Je n'en voudrais à personne si je n'ai pas de réponse précise, simplement
des orientations m'aideraient..

Par rapport au matos, globalement, c'est équivalent, puisque j'avais essayé
avec les mêmes données, pour un résultat équivalent...

Il semble vraiment que ce soit l'augmentation du nombre de périodes qui
augmente la durée du processus... de façon exponentielle

c'est à dire cette partie : 'j'ai supprimé le message source pour réduire la
longeur du message)
=================================================
Do
CompteurPer = CompteurPer + 1
'La période existe, c'est obligatoire...
KelPer = rstPP.Fields("N°Periode")

KelMois = rstPP.Fields("Mois")
KelAnnee = rstPP.Fields("Annee")

Select Case KelNiv
Case Is <= 3
If Left(NivEmp, 2) <> "10" Then
MontantRef = MontantRef * (1 + rstPP.Fields("AugmenT1"))
End If
Case 4 To 6
MontantRef = MontantRef * (1 + rstPP.Fields("AugmenT2"))
Case Else
MontantRef = MontantRef * (1 + rstPP.Fields("AugmenT3"))
End Select

If NumP = 2 Then 'Prime d'ancienneté
If KelNiv <= NivRef And Right(NivEmp, 2) <> "6B" And Left(NivEmp,
2) <> "10" Then
sql = "SELECT Primes.N°Prime, SuiviSalarie.Salarie,
Periodes.Reel, SuiviSalarie.Montant, Periodes.N°Periode, Primes.CP " & _
"FROM Periodes INNER JOIN (Primes INNER JOIN SuiviSalarie ON
Primes.N°Prime = SuiviSalarie.Prime) ON Periodes.N°Periode =
SuiviSalarie.Periode " & _
"WHERE (SuiviSalarie.Salarie=" & NumEmp & ") AND
(Periodes.N°Periode=" & KelPer & ") AND (Periodes.Reel=" &
IIf(Forms("FormMenuPrinc").CACType, 2, 3) & ") AND N°Prime=1;"
Dim rsBaseEmp As DAO.Recordset

Set rsBaseEmp = dbs.OpenRecordset(sql, dbOpenDynaset)
rsBaseEmp.MoveFirst
BaseEmp = rsBaseEmp.Fields("Montant")
MontantRef = BaseEmp * (IIf(MaxAnc / 100 > Int(((KelAnnee -
AnneeEmb) * 12 + KelMois - MoisEmb - 1) / 12) / 100, Int(((KelAnnee -
AnneeEmb) * 12 + KelMois - MoisEmb - 1) / 12) / 100, MaxAnc / 100))
End If

'Gratification d'ancienneté 'annulé sur demande de DDL !

End If
If CodeP = "2042" Or CodeP = "2044" Or _
CodeP = "2048" Or CodeP = "2058" Or CodeP = "9BAP" Or _
CodeP = "/101" Then
Else
Dim rsCP As DAO.Recordset
Set rsCP = dbs.OpenRecordset("SELECT Primes.* FROM Primes WHERE
Primes.N°Prime = " & NumP & ";")
rsCP.MoveFirst

CPOK = rsCP.Fields("CP")

If NumP = 3 Then 'Abondement
MontantRef = MontantAbond
End If
If NumP = 4 Then 'Intéressement
MontantRef = MontantInter
End If
If NumP = 5 Then 'Participation
MontantRef = MontantPart
End If
If NumP = 6 Then 'Présentéïsme
MontantRef = MontantPres
End If
If NumP = 7 Then 'Bonus Or CodeP = "9106"
'tous les mois !
'Niveau 7 et 8 : 10% du salaire annuel
If KelNiv = 7 Or KelNiv = 8 Then
MontantRef = BaseEmp * 13 * 0.1 / 12
End If
'niveau 9 : 15% ou 20% selon les cas (20% pour 2 personnes)
If KelNiv = 9 Then
If NumEmp = Bonus1 Or NumEmp = Bonus2 Then
MontantRef = BaseEmp * 13 * 0.2 / 12
Else
MontantRef = BaseEmp * 13 * 0.15 / 12
End If
End If
End If

rstSuiviS.AddNew
rstSuiviS.Fields("Salarie") = NumEmp
rstSuiviS.Fields("Periode") = KelPer
rstSuiviS.Fields("Prime") = NumP
rstSuiviS.Fields("Montant") = MontantRef
If NumP > 0 And CPOK Then
rstSuiviS.Fields("MontantCP") = rstSuiviS.Fields("Montant") *
TxCP
Else
rstSuiviS.Fields("MontantCP") = 0
End If
rstSuiviS.Update
End If
'============================================= 'La suite n'est à faire qu'une seule fois !!!
If CompteurPrime = 1 Then
'KelTaux = 1

'Par employé et par période...
Dim rstCont As DAO.Recordset
Dim sqlCont As String
sqlCont = "SELECT SuiviSalarieAnnexe.* FROM SuiviSalarieAnnexe " &
_
"WHERE SuiviSalarieAnnexe.Salarie = " & NumEmp & " AND
SuiviSalarieAnnexe.Periode = " & KelPer & ";"

Set rstCont = dbs.OpenRecordset(sqlCont, dbOpenDynaset)
If rstCont.RecordCount <= 0 Then

rstSuiviAnS.AddNew
rstSuiviAnS.Fields("Salarie") = NumEmp
rstSuiviAnS.Fields("Periode") = KelPer
rstSuiviAnS.Fields("CB") = KelCB
rstSuiviAnS.Fields("Niveau") = NumNiv
rstSuiviAnS.Fields("Statut") = KelStatut
rstSuiviAnS.Fields("Taux") = KelTaux
rstSuiviAnS.Fields("TypeContrat") = KelContrat

rstSuiviAnS.Update
End If
End If
'===============================================
rstPP.MoveNext
Loop Until rstPP.EOF

=================================================
--

Bien cordialement,

Joël GARBE
www.joelgarbe.fr

Raymond [mvp]

14/04/2005 à 21:03

quelques remarques:

la table Constantes est ouverte sous plusieurs objets , rst, rstE. ceci
prend beaucoup de place car tu ne fermes pas les objets et beaucoup de
temps.
pourquoi If rstE.RecordCount = 0 Then, puisque tu as déjà lu la table ou
alors mettre le test sur la 1ere lecture.
n'utilises pas le même rstE pour les constantes et les employés, ça fausse
la vision.
dès que tu as terminé les constantes, en début de procédure, ferme tous les
objets ouverts correspondants.
au lieu de faire un movelast , passer par un recordsetclone
afficher des données dans un formulaire pendant la procédure doit être évité
(surtout sans DoEvents) car c'est le temps le plus long.
Forms("frmProgressBis").Caption = "MAJ Employé : " & rstE.Fields("Nom") & "
" & rstE.Fields("PreNom")
ReDim Preserve est très long, à la limite il vaut mieux prévoir le
recordcount + un peu plus et faire un seul redim à la fin
ne pas mettre de movefirst après le openrecordset
éviter les Dim en plein milieu , les mettre au début
pas besoin de close pour les recordset si on fait nothing.
fermer les objets dès qu'ils ne servent plus
Indenter le code avec un programme d'indentation pour faciliter la lecture.

ceci est une première idée qui ne va pas révolutionner le monde mais qui
peut réduire un peu le temps.
--
@+
Raymond Access MVP
http://OfficeSystem.Access.free.fr/
http://OfficeSystem.Access.free.fr/runtime/
http://users.skynet.be/mpfa/ pour débuter sur le forum

"Joël GARBE" a écrit dans le message de news:
425eb4c8$0$19325$

Merci Raymond,

Joël GARBE

14/04/2005 à 21:15

Merci déjà pour ces premiers conseils...

Je vais commencer par là !

--

Bien cordialement,

Joël GARBE
www.joelgarbe.fr
"Raymond [mvp]" a écrit dans le message de
news: %

quelques remarques:

la table Constantes est ouverte sous plusieurs objets , rst, rstE. ceci
prend beaucoup de place car tu ne fermes pas les objets et beaucoup de
temps.
pourquoi If rstE.RecordCount = 0 Then, puisque tu as déjà lu la table ou
alors mettre le test sur la 1ere lecture.
n'utilises pas le même rstE pour les constantes et les employés, ça fausse
la vision.
dès que tu as terminé les constantes, en début de procédure, ferme tous
les objets ouverts correspondants.
au lieu de faire un movelast , passer par un recordsetclone
afficher des données dans un formulaire pendant la procédure doit être
évité (surtout sans DoEvents) car c'est le temps le plus long.
Forms("frmProgressBis").Caption = "MAJ Employé : " & rstE.Fields("Nom") &
" " & rstE.Fields("PreNom")
ReDim Preserve est très long, à la limite il vaut mieux prévoir le
recordcount + un peu plus et faire un seul redim à la fin
ne pas mettre de movefirst après le openrecordset
éviter les Dim en plein milieu , les mettre au début
pas besoin de close pour les recordset si on fait nothing.
fermer les objets dès qu'ils ne servent plus
Indenter le code avec un programme d'indentation pour faciliter la
lecture.

ceci est une première idée qui ne va pas révolutionner le monde mais qui
peut réduire un peu le temps.
--
@+
Raymond Access MVP
http://OfficeSystem.Access.free.fr/
http://OfficeSystem.Access.free.fr/runtime/
http://users.skynet.be/mpfa/ pour débuter sur le forum

"Joël GARBE" a écrit dans le message de news:
425eb4c8$0$19325$
Merci Raymond,

Joël GARBE

15/04/2005 à 09:10

Bonjour Raymond :

Une information qui a son importance : La base de l'autre poste est
installée sur un disque réseau... je pense que les requêtes à l'intérieur de
la boucle dans ce cas rallentissent considérablement le processus...
j'étudie la possibilité d'effectuer ces requêtes une seule fois, et stoquer
les informations dans une variable tableau ?

Encore merci pour ton aide
--

Bien cordialement,

Joël GARBE
www.joelgarbe.fr
"Raymond [mvp]" a écrit dans le message de
news: %

quelques remarques:

la table Constantes est ouverte sous plusieurs objets , rst, rstE. ceci
prend beaucoup de place car tu ne fermes pas les objets et beaucoup de
temps.
pourquoi If rstE.RecordCount = 0 Then, puisque tu as déjà lu la table ou
alors mettre le test sur la 1ere lecture.
n'utilises pas le même rstE pour les constantes et les employés, ça fausse
la vision.
dès que tu as terminé les constantes, en début de procédure, ferme tous
les objets ouverts correspondants.
au lieu de faire un movelast , passer par un recordsetclone
afficher des données dans un formulaire pendant la procédure doit être
évité (surtout sans DoEvents) car c'est le temps le plus long.
Forms("frmProgressBis").Caption = "MAJ Employé : " & rstE.Fields("Nom") &
" " & rstE.Fields("PreNom")
ReDim Preserve est très long, à la limite il vaut mieux prévoir le
recordcount + un peu plus et faire un seul redim à la fin
ne pas mettre de movefirst après le openrecordset
éviter les Dim en plein milieu , les mettre au début
pas besoin de close pour les recordset si on fait nothing.
fermer les objets dès qu'ils ne servent plus
Indenter le code avec un programme d'indentation pour faciliter la
lecture.

ceci est une première idée qui ne va pas révolutionner le monde mais qui
peut réduire un peu le temps.
--
@+
Raymond Access MVP
http://OfficeSystem.Access.free.fr/
http://OfficeSystem.Access.free.fr/runtime/
http://users.skynet.be/mpfa/ pour débuter sur le forum

"Joël GARBE" a écrit dans le message de news:
425eb4c8$0$19325$
Merci Raymond,

Bonjour Raymond :

Une information qui a son importance : La base de l'autre poste est
installée sur un disque réseau... je pense que les requêtes à l'intérieur de
la boucle dans ce cas rallentissent considérablement le processus...
j'étudie la possibilité d'effectuer ces requêtes une seule fois, et stoquer
les informations dans une variable tableau ?

Encore merci pour ton aide
--

Bien cordialement,

Joël GARBE
www.joelgarbe.fr
"Raymond [mvp]" <XYZ.officesystem.access@free.fr> a écrit dans le message de
news: %23hKXpSSQFHA.508@TK2MSFTNGP12.phx.gbl...

quelques remarques:

la table Constantes est ouverte sous plusieurs objets , rst, rstE. ceci
prend beaucoup de place car tu ne fermes pas les objets et beaucoup de
temps.
pourquoi If rstE.RecordCount = 0 Then, puisque tu as déjà lu la table ou
alors mettre le test sur la 1ere lecture.
n'utilises pas le même rstE pour les constantes et les employés, ça fausse
la vision.
dès que tu as terminé les constantes, en début de procédure, ferme tous
les objets ouverts correspondants.
au lieu de faire un movelast , passer par un recordsetclone
afficher des données dans un formulaire pendant la procédure doit être
évité (surtout sans DoEvents) car c'est le temps le plus long.
Forms("frmProgressBis").Caption = "MAJ Employé : " & rstE.Fields("Nom") &
" " & rstE.Fields("PreNom")
ReDim Preserve est très long, à la limite il vaut mieux prévoir le
recordcount + un peu plus et faire un seul redim à la fin
ne pas mettre de movefirst après le openrecordset
éviter les Dim en plein milieu , les mettre au début
pas besoin de close pour les recordset si on fait nothing.
fermer les objets dès qu'ils ne servent plus
Indenter le code avec un programme d'indentation pour faciliter la
lecture.

ceci est une première idée qui ne va pas révolutionner le monde mais qui
peut réduire un peu le temps.
--
@+
Raymond Access MVP
http://OfficeSystem.Access.free.fr/
http://OfficeSystem.Access.free.fr/runtime/
http://users.skynet.be/mpfa/ pour débuter sur le forum

"Joël GARBE" <joel-garbe@wanadoo.fr> a écrit dans le message de news:
425eb4c8$0$19325$8fcfb975@news.wanadoo.fr...

Merci Raymond,

Vous avez filtré cet utilisateur ! Consultez son message

Bonjour Raymond :

Une information qui a son importance : La base de l'autre poste est
installée sur un disque réseau... je pense que les requêtes à l'intérieur de
la boucle dans ce cas rallentissent considérablement le processus...
j'étudie la possibilité d'effectuer ces requêtes une seule fois, et stoquer
les informations dans une variable tableau ?

Encore merci pour ton aide
--

Bien cordialement,

Joël GARBE
www.joelgarbe.fr
"Raymond [mvp]" a écrit dans le message de
news: %

quelques remarques:

la table Constantes est ouverte sous plusieurs objets , rst, rstE. ceci
prend beaucoup de place car tu ne fermes pas les objets et beaucoup de
temps.
pourquoi If rstE.RecordCount = 0 Then, puisque tu as déjà lu la table ou
alors mettre le test sur la 1ere lecture.
n'utilises pas le même rstE pour les constantes et les employés, ça fausse
la vision.
dès que tu as terminé les constantes, en début de procédure, ferme tous
les objets ouverts correspondants.
au lieu de faire un movelast , passer par un recordsetclone
afficher des données dans un formulaire pendant la procédure doit être
évité (surtout sans DoEvents) car c'est le temps le plus long.
Forms("frmProgressBis").Caption = "MAJ Employé : " & rstE.Fields("Nom") &
" " & rstE.Fields("PreNom")
ReDim Preserve est très long, à la limite il vaut mieux prévoir le
recordcount + un peu plus et faire un seul redim à la fin
ne pas mettre de movefirst après le openrecordset
éviter les Dim en plein milieu , les mettre au début
pas besoin de close pour les recordset si on fait nothing.
fermer les objets dès qu'ils ne servent plus
Indenter le code avec un programme d'indentation pour faciliter la
lecture.

ceci est une première idée qui ne va pas révolutionner le monde mais qui
peut réduire un peu le temps.
--
@+
Raymond Access MVP
http://OfficeSystem.Access.free.fr/
http://OfficeSystem.Access.free.fr/runtime/
http://users.skynet.be/mpfa/ pour débuter sur le forum

"Joël GARBE" a écrit dans le message de news:
425eb4c8$0$19325$
Merci Raymond,

Raymond [mvp]

15/04/2005 à 11:16

Bonjour.

si c'est vraiment ton réseau qui est la cause d'un ralentissement excessif,
tu installes le runtime sur ton serveur avec une mde de ta base frontale et
tu exécutes tes requêtes et calculs dans cette base.

--
@+
Raymond Access MVP
http://OfficeSystem.Access.free.fr/
http://OfficeSystem.Access.free.fr/runtime/
http://users.skynet.be/mpfa/ pour débuter sur le forum

"Joël GARBE" a écrit dans le message de news:
425f68ee$0$1216$

Bonjour Raymond :

Une information qui a son importance : La base de l'autre poste est
installée sur un disque réseau... je pense que les requêtes à l'intérieur
de la boucle dans ce cas rallentissent considérablement le processus...
j'étudie la possibilité d'effectuer ces requêtes une seule fois, et
stoquer les informations dans une variable tableau ?

Encore merci pour ton aide
--

Bien cordialement,

Joël GARBE

Joël GARBE

15/04/2005 à 12:35

Merci Raymond

pour ce conseil qui doit être judiceux je suppose, mais je ne suis qu'un
petit développeur, je n'ai pas les outils nécessaires pour créer un mde.

Que faut-il exactement ? Où acheter ? Y a-t-il des contraintes si multi
utilisateurs par exemple ?

Je cherche de mon côté bien sûr... encore Merci !
--

Bien cordialement,

Joël GARBE
www.joelgarbe.fr
"Raymond [mvp]" a écrit dans le message de
news: eo8$

Bonjour.

si c'est vraiment ton réseau qui est la cause d'un ralentissement
excessif, tu installes le runtime sur ton serveur avec une mde de ta base
frontale et tu exécutes tes requêtes et calculs dans cette base.

--
@+
Raymond Access MVP
http://OfficeSystem.Access.free.fr/
http://OfficeSystem.Access.free.fr/runtime/
http://users.skynet.be/mpfa/ pour débuter sur le forum

"Joël GARBE" a écrit dans le message de news:
425f68ee$0$1216$
Bonjour Raymond :

Une information qui a son importance : La base de l'autre poste est
installée sur un disque réseau... je pense que les requêtes à l'intérieur
de la boucle dans ce cas rallentissent considérablement le processus...
j'étudie la possibilité d'effectuer ces requêtes une seule fois, et
stoquer les informations dans une variable tableau ?

Encore merci pour ton aide
--

Bien cordialement,

Joël GARBE

Raymond [mvp]

15/04/2005 à 13:25

tu peux créer une mde à partir de ta base mdb
outils / utilitaires / créer une mde

--
@+
Raymond Access MVP
http://OfficeSystem.Access.free.fr/
http://OfficeSystem.Access.free.fr/runtime/
http://users.skynet.be/mpfa/ pour débuter sur le forum

"Joël GARBE" a écrit dans le message de news:
425f98f5$0$19338$

Merci Raymond

pour ce conseil qui doit être judiceux je suppose, mais je ne suis qu'un
petit développeur, je n'ai pas les outils nécessaires pour créer un mde.

Que faut-il exactement ? Où acheter ? Y a-t-il des contraintes si multi
utilisateurs par exemple ?

Je cherche de mon côté bien sûr... encore Merci !
--

Bien cordialement,

Joël GARBE

vitesse d'exécution...

10 réponses

Veuillez sélectionner un problème