Remplir des tables en respectant des conditions

Remplir des tables en respectant des conditions - VB/VBA/VBS - Programmation

Marsh Posté le 21-07-2008 à 10:57:38    

Bonjour,  
 
Aujourd'hui, je suis confrontée à un nouveau problème.
Le code VBA qu'un de mes amis à développer ne réalise pas ce qu'il devrait.
 
Comme vous pouvez le voir sur ici http://dl.free.fr/q7QE5mymm/CODEVISUALBASICtest.doc , je dispose d'un formulaire me permettant de faire des calculs.
 
L'idée, c'est qu'on sélectionne certaines informations dans les tableaux Uo, Met, Rub, Res… (on peut sélectionner ce que l'on veut), on sélectionne dans clé1_top à clé 11_top une ou plusieurs clés et un pourcentage en face de chacune d'elle.
Puis une priorité.
On clique sur le bouton de validation et cela rempli la table table_repartition.
Puis en cliquant sur Calculer les répartitions, la table table_tmp_repartition est rempli avec les enregistrements de la table donnees qui répondent aux conditions de la table table_repartition.  
La table table_tmp_repartition doit être remplie selon un ordre précis :
 
Dans la table table_correspondance_cle_requete, des ordres sont attribués aux clés.  
Chaque clé est paramétrée à l'aide de table ou de requête contenant toutes les champs Res et pourcentage.
Dans Res on retrouve les VC, VI, VM, VT, VW, EC, EE, RT, HI, EA et PT (correspondant respectivement au case VC, VI, VM, VT, VW, EC, CE, PDV, HI, MS et PT du formulaire).
A chaque Res est associé un pourcentage.
 
Access doit d'avoir faire les calculs sur les enregistrements de la table donnees qui ont les mêmes caractéristiques que les enregistrements de la table table_repartition et auxquelles nous avons attribués des clés d'ordre 1 puis 2 puis 3 puis …  
Pour chacun des ordres, les calculs doivent se faire en respectant les priorités : d'avoir les priorités 10 puis 15 puis 20, 30 …140.  
Lorsque les enregistrements ont été calculés 1 fois, il ne faut plus les recalculer après.
 
J'ai créé une requête (requete_verification_ecritures_totalement_reparties) qui permet de calculer le total de répartition. Si cela dépasse 100% (si c'est 99,99 ou 100,1 ce n'est pas grave) c'est qu'il y a une erreur.
 
Le script est le suivant :
 
Sub remplir_table_tmp_repartition()
    Dim db As Database
    Dim WrkSpc As Workspace
    Dim SQL, SQL2, where, req, SQLvars, SQLvalues As String
    Dim recs, recs2, recst As Recordset
    Dim i As Integer
    Dim id As Long
    Dim Res, UO As String
    Dim vVC, vVI, vVM, vVT, vVW, vEC, vEE, vRT, vHI, vEA, vPT As Double
    Dim val, pi As Double
    Dim ordre, vordre, ordre_max, vordre_max As Integer
 
    Set db = CurrentDb()
    Set WrkSpc = DBEngine.Workspaces(0)
    Me.ProgressBar_calcul.Max = 3 * DCount("[cle1]", "[table_repartition]" )
    Me.ProgressBar_calcul = 0
     
    ' On vide la table table_tmp_repartition
    SQL = "DELETE * FROM table_tmp_repartition"
    DoCmd.SetWarnings False
    db.Execute SQL
    DoCmd.SetWarnings True
     
    ordre_max = DMax("[ordre]", "[table_correspondance_cle_requete]" )
     
    For ordre = 1 To ordre_max
         
        Set recs = db.OpenRecordset("SELECT * from table_repartition ORDER BY priorite", dbOpenSnapshot, dbForwardOnly)
        Do While Not recs.EOF
            Me.ProgressBar_calcul = Me.ProgressBar_calcul + 1
            ' on va calculer les pourcentages
            vVC = 0
            vVI = 0
            vVM = 0
            vVT = 0
            vVW = 0
            vEC = 0
            vEE = 0
            vRT = 0
            vHI = 0
            vEA = 0
            vPT = 0
             
            vordre_max = 0
            For i = 1 To 11
                pi = recs.Fields("pourcentage" & Format(i))
                If pi > 0 Then
                    vordre = DLookup("[ordre]", "[table_correspondance_cle_requete]", "ID_cle = " & recs.Fields("cle" & Format(i)))
                    If vordre > ordre Then
                        vordre_max = 0
                        Exit For
                    Else
                        If vordre > vordre_max Then
                            vordre_max = vordre
                        End If
                        req = DLookup("[nom_requete]", "[table_correspondance_cle_requete]", "ID_cle = " & recs.Fields("cle" & Format(i)))
                        If req = "table_cle_taux_activite" Then
                            UO = recs.Fields("UO" )
                            If Len(UO) = 0 Then
                                MsgBox "La clé taux d'activité est affectée à une écriture sans avoir précisé l'UO. Calcul de la répartition impossible"
                                Exit Sub
                            End If
                            req = "SELECT * FROM " & req & " WHERE UO = '" & UO & "';"
                        End If
                        Set recst = db.OpenRecordset(req, dbOpenSnapshot, dbForwardOnly)
                        Do While Not recst.EOF
                            Res = recst.Fields("Res" )
                            val = recst.Fields("pourcentage" )
                            Select Case Res
                                Case "VC"
                                    vVC = vVC + val * pi
                                Case "VI"
                                    vVI = vVI + val * pi
                                Case "VM"
                                    vVM = vVM + val * pi
                                Case "VT"
                                    vVT = vVT + val * pi
                                Case "VW"
                                    vVW = vVW + val * pi
                                Case "EC"
                                    vEC = vEC + val * pi
                                Case "EE"
                                    vEE = vEE + val * pi
                                Case "RT"
                                    vRT = vRT + val * pi
                                Case "HI"
                                    vHI = vHI + val * pi
                                Case "EA"
                                    vEA = vEA + val * pi
                                Case "PT"
                                    vPT = vPT + val * pi
                            End Select
                            recst.MoveNext
                        Loop
                        recst.Close
                    End If
                End If
            Next i
         
            If ordre = vordre_max Then
                ' on cherche les lignes de la table donnees qui correspondent
                where = ""
                For Each Field In Array("UO", "Met", "Rub", "Cpt", "Proj", "Res", "Segop", "Lb", "Rve", "Ste" )
                    If Len(recs.Fields(Field)) > 0 Then
                        If Len(where) > 0 Then
                            where = where & " AND "
                        End If
                        If (Field = "Cpt" ) Or Field = "Ste" Then
                            where = where & Field & " = " & recs.Fields(Field)
                        Else
                            where = where & Field & " = '" & recs.Fields(Field) & "'"
                        End If
                    End If
                Next
                SQL = "SELECT DISTINCT ID_ecriture FROM Donnees"
                If Len(where) > 0 Then
                    SQL = SQL & " WHERE " & where
                End If
                SQL = SQL & ";"
                Set recs2 = db.OpenRecordset(SQL, dbOpenSnapshot, dbForwardOnly)
                Do While Not recs2.EOF
                    id = recs2.Fields("ID_ecriture" )
                    WrkSpc.BeginTrans
                    SQL2 = "INSERT INTO table_tmp_repartition (ID_ecriture, Res_a_imputer,Pourcentage) VALUES ('" & id & "', 'VC','" & vVC & "');"
                    db.Execute SQL2
                    SQL2 = "INSERT INTO table_tmp_repartition (ID_ecriture, Res_a_imputer,Pourcentage) VALUES ('" & id & "', 'VI','" & vVI & "');"
                    db.Execute SQL2
                    SQL2 = "INSERT INTO table_tmp_repartition (ID_ecriture, Res_a_imputer,Pourcentage) VALUES ('" & id & "', 'VM','" & vVM & "');"
                    db.Execute SQL2
                    SQL2 = "INSERT INTO table_tmp_repartition (ID_ecriture, Res_a_imputer,Pourcentage) VALUES ('" & id & "', 'VT','" & vVT & "');"
                    db.Execute SQL2
                    SQL2 = "INSERT INTO table_tmp_repartition (ID_ecriture, Res_a_imputer,Pourcentage) VALUES ('" & id & "', 'VW','" & vVW & "');"
                    db.Execute SQL2
                    SQL2 = "INSERT INTO table_tmp_repartition (ID_ecriture, Res_a_imputer,Pourcentage) VALUES ('" & id & "', 'EC','" & vEC & "');"
                    db.Execute SQL2
                    SQL2 = "INSERT INTO table_tmp_repartition (ID_ecriture, Res_a_imputer,Pourcentage) VALUES ('" & id & "', 'EE','" & vEE & "');"
                    db.Execute SQL2
                    SQL2 = "INSERT INTO table_tmp_repartition (ID_ecriture, Res_a_imputer,Pourcentage) VALUES ('" & id & "', 'RT','" & vRT & "');"
                    db.Execute SQL2
                    SQL2 = "INSERT INTO table_tmp_repartition (ID_ecriture, Res_a_imputer,Pourcentage) VALUES ('" & id & "', 'HI','" & vHI & "');"
                    db.Execute SQL2
                    SQL2 = "INSERT INTO table_tmp_repartition (ID_ecriture, Res_a_imputer,Pourcentage) VALUES ('" & id & "', 'EA','" & vEA & "');"
                    db.Execute SQL2
                    SQL2 = "INSERT INTO table_tmp_repartition (ID_ecriture, Res_a_imputer,Pourcentage) VALUES ('" & id & "', 'PT','" & vPT & "');"
                    db.Execute SQL2
                    WrkSpc.CommitTrans
                     
                    recs2.MoveNext
                Loop
            End If
            recs.MoveNext
        Loop
        recs.Close
    Next ordre
End Sub
 
La base se trouve ici :
http://dl.free.fr/qDMOdqfGB/CR_mod [...] -07-18.zip
 
J'ai vraiment besoin d'aide. C'est très très urgent et je n'arrive pas à trouver la solution.
Si ça se trouve ce n'est vraiment pas grand-chose.  
Vraiment cela serait génial si vous pouviez m'aider. Je commence à ne plus avoir de cheveux à force de me les arracher !!!!
 
Merci encore  
 
 
 
 

Reply

Marsh Posté le 21-07-2008 à 10:57:38   

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed