problème de recordset ou de querydef

problème de recordset ou de querydef - VB/VBA/VBS - Programmation

Marsh Posté le 31-03-2009 à 12:03:36    

Bonjour a tous,  
voilà mon problème. j'ai une appli excel qui tourne bien et qui copie des données d'une BD. L'un des champ de la BD est l'année et la Macro s'exécute bien pour des données entre 2004 et 2007
Maintenant, je voudrais que ça marche pour des données entre 2004 et 2008 et c'est là que je coince.
Si une ame charitable pouvais me dire ce qui ne va pas dasn mon code, ce serait extremement sympa et m'enlèverait une bonne épine du pied.
 
Merci d'avance
 
P.S; voici le code de ma Macro. Le code qu'il y a en gras EN NOIR correspond au "chemin" que prend ma Macro pour les données 2008. Moi, je voudrais que pour mes données 2008, la Macro prenne le meme "chemin" que pour les données des autres années (en gras de couleur)
 
 
Function MAJAux(NomRequete As String, Donnee As String, Apporteur As String, db As Database)
 
 
Dim qdf As QueryDef
Dim rs As Recordset
 
Dim Trouver As Boolean
Dim Annee As String
Dim PrimA
Dim SP
Dim SP30k
 
Set qdf = db.QueryDefs(NomRequete)
qdf.Parameters("VCodeApporteur" ) = Apporteur
 
Set rs = qdf.OpenRecordset(dbOpenDynaset, dbReadOnly)
 
If Nbrs(rs) = 0 Then
For i = 2004 To 2008
    db.Execute ("INSERT INTO Sortie ( Donnee ,Apporteur, Annee, PrimeAcquise, SP, SP30k,Erreur ) VALUES ('" & Donnee & "','" & Apporteur & "','" & i & "','0','0','0','VIDE')" )
Next i
Else
For i = 2004 To 2008
    rs.MoveFirst
    Trouver = False
    For j = 1 To Nbrs(rs)
    'While (rs.EOF = False) Or (Trouver = False)
    If rs![Exercice] = "" & i Then
        Trouver = True
        PrimA = rs!["Montant des primes acquises"]
        If PrimA = 0 Then
            SP = 0
            SP30k = 0
        Else:
            SP = rs![SP] / 100
            SP30k = rs![SPDec] / 100
        End If
        'MsgBox "" & Annee & "//" & PrimA & "//" & SP & "//" & SP30k & "//"
        db.Execute ("INSERT INTO Sortie ( Donnee ,Apporteur, Annee, PrimeAcquise, SP, SP30k, Erreur ) VALUES ('" & Donnee & "','" & Apporteur & "','" & i & "','" & PrimA & "','" & SP & "','" & SP30k & "','OK')" )    'Else
        'rs.MoveNext
    End If
    rs.MoveNext
    'Wend
    Next j
  If (Trouver = False) Then db.Execute ("INSERT INTO Sortie ( Donnee ,Apporteur, Annee, PrimeAcquise, SP, SP30k, Erreur ) VALUES ('" & Donnee & "','" & Apporteur & "','" & i & "','0','0','0','KO')" )    
    Next i
End If
 
Set rs = Nothing
Set qdf = Nothing
 
End Function
 
Sub MAJ()
 
Dim VcodeApporteur As String
VcodeApporteur = ThisWorkbook.Worksheets("Feuil1" ).Range("C10" ).Value
'MsgBox "Mise à jour de la feuille pour les données de l'apporteur " & VcodeApporteur
 
Dim db As Database
Dim rs As Recordset
Dim rsi As Recordset
Dim qdf As QueryDef
Dim qdfDel As QueryDef
Dim st1 As String
Dim TabDonnee(1 To 8, 1 To 2) As String
 
TabDonnee(1, 1) = "SP_GLOBAL"
TabDonnee(1, 2) = "Etat_MontantPrimeAcquise_SP_SPDec par annee"
TabDonnee(2, 1) = "SP_AUTO"
TabDonnee(2, 2) = "Etat_MontantPrimeAcquise_SP_SPDec AUTO par annee"
TabDonnee(3, 1) = "SP_AUTO_rc"
TabDonnee(3, 2) = "Etat_MontantPrimeAcquise_SP_SPDec AUTO_respciv par annee"
TabDonnee(4, 1) = "SP_AUTO_dommage"
TabDonnee(4, 2) = "Etat_MontantPrimeAcquise_SP_SPDec AUTO_dommage par annee"
TabDonnee(5, 1) = "SP_INCENDIE"
TabDonnee(5, 2) = "Etat_MontantPrimeAcquise_SP_SPDec INCENDIE par annee"
TabDonnee(6, 1) = "SP_INCENDIE_mrh"
TabDonnee(6, 2) = "Etat_MontantPrimeAcquise_SP_SPDec INCENDIE_MRH par annee"
TabDonnee(7, 1) = "SP_INCENDIE_mac"
TabDonnee(7, 2) = "Etat_MontantPrimeAcquise_SP_SPDec INCENDIE_MAC par annee"
TabDonnee(8, 1) = "SP_RD"
TabDonnee(8, 2) = "Etat_MontantPrimeAcquise_SP_SPDec RD par annee"
 
Set db = OpenDatabase("chemin de la base de données" )
Set qdfDel = db.QueryDefs("DELETE_Sortie" )
 
'Efface les donnees dans Sortie
qdfDel.Execute
 
'Efface les donnees dans la feuille 2
ThisWorkbook.Worksheets("Feuil2" ).Shapes.SelectAll
Selection.Delete
ThisWorkbook.Worksheets("Feuil2" ).Cells.Clear
 
'Appel la fonction de remplissage de Sorie
For i = 1 To 8
    MAJAux TabDonnee(i, 2), TabDonnee(i, 1), VcodeApporteur, db
Next i
 
'Met la feuille2 a jour
Set rs = db.OpenRecordset("Sortie", dbOpenTable)
ThisWorkbook.Worksheets("Feuil2" ).Range("A1" ).CopyFromRecordset rs
 
'Met la feuille 1 a jour
Set qdf = db.QueryDefs("INFO_Apporteur" )
qdf.Parameters("VCodeApporteur" ) = VcodeApporteur
Set rsi = qdf.OpenRecordset(dbOpenForwardOnly, dbReadOnly)
 
ThisWorkbook.Worksheets("Feuil1" ).Range("G8" ).Value = rsi![Site de rattachement]
ThisWorkbook.Worksheets("Feuil1" ).Range("G10" ).Value = rsi![Type Apporteur]
ThisWorkbook.Worksheets("Feuil1" ).Range("C8" ).Value = rsi![Point de vente]
 
db.Close
Set db = Nothing
Set rs = Nothing
Set rsi = Nothing
Set qdf = Nothing
Set qdfDel = Nothing
MsgBox "Mise à jour effectuée avec succès!"
 
End Sub

Reply

Marsh Posté le 31-03-2009 à 12:03:36   

Reply

Marsh Posté le 31-03-2009 à 13:04:25    

KO est inséré parce que la variable Trouver = False.
 
En remontant dans le programme, on voit que Trouver = True si

If rs![Exercice] = "" & i

Cette ligne signifie que la colone Exercice du recordset doit contenir i, lequel contient l'année.
 
En remontant, on voit que le recordset rs est rempli par :

Set qdf = db.QueryDefs(NomRequete)  
qdf.Parameters("VCodeApporteur" ) = Apporteur  
Set rs = qdf.OpenRecordset(dbOpenDynaset, dbReadOnly)

Maintenant, je ne peux plus remonter plus haut. Désolé.
 
Il faudrait voir le contenu de la contenu de la requête dont le nom est passée en paramètre à la fonction. Elle doit interroger une ou plusieurs tables. Ce ou ces tables, doivent avoir quelque part une colonne nommée Exercice, mais cette colonne ne doit pas contenir la valeur 2008 pour l'Apporteur en cours.

Reply

Marsh Posté le 31-03-2009 à 13:25:50    

olivthill a écrit :

KO est inséré parce que la variable Trouver = False.
 
En remontant dans le programme, on voit que Trouver = True si

If rs![Exercice] = "" & i

Cette ligne signifie que la colone Exercice du recordset doit contenir i, lequel contient l'année.
 
En remontant, on voit que le recordset rs est rempli par :

Set qdf = db.QueryDefs(NomRequete)  
qdf.Parameters("VCodeApporteur" ) = Apporteur  
Set rs = qdf.OpenRecordset(dbOpenDynaset, dbReadOnly)

Maintenant, je ne peux plus remonter plus haut. Désolé.
 
Il faudrait voir le contenu de la contenu de la requête dont le nom est passée en paramètre à la fonction. Elle doit interroger une ou plusieurs tables. Ce ou ces tables, doivent avoir quelque part une colonne nommée Exercice, mais cette colonne ne doit pas contenir la valeur 2008 pour l'Apporteur en cours.


 
Ok, merci beaucoup pour cette réponse ultra rapide et qui m'a l'air pertinente (juste eu le tps de déjeuner)
c'est vrai que j'ai pas mal de requetes dans ma BD Access et que je n'ai pas eu le tps de les étudier de près
je vois ça ASAP
 
Merci encore pour le tuyau
 
P.S: tu parles bien de requetes dans la BD ACCESS ?

Reply

Marsh Posté le 31-03-2009 à 14:09:00    

Oui. Excel n'a pas de requête. Acess a un onglet requête, et je suppose que c'est l'une d'elle qui est utilisée par la ligne :

Set qdf = db.QueryDefs(NomRequete)  

Mais le problème ne viendrait pas de la requête, mais plutôt de l'année 2008 qui serait manquante dans une table. Peut-être, qu'il existe une table des exercices, ou bien une table qui relie un apporteur et une année.

Reply

Marsh Posté le 31-03-2009 à 14:36:29    

olivthill a écrit :

Oui. Excel n'a pas de requête. Acess a un onglet requête, et je suppose que c'est l'une d'elle qui est utilisée par la ligne :

Set qdf = db.QueryDefs(NomRequete)  

Mais le problème ne viendrait pas de la requête, mais plutôt de l'année 2008 qui serait manquante dans une table. Peut-être, qu'il existe une table des exercices, ou bien une table qui relie un apporteur et une année.


 
En fait, j'ai identifié le problème. Comme tu l'avais dis. Le pb venait des requetes Access car elles utilisaient le champ "exercice" et à chaque fois, il manquait la donnée "2008".  
 
En tout cas, l'appli a l'air de fonctionner correctement. Il me reste plus qu'à vérifier la cohérences des résultats mais c'est une autre histoire
 
En tout cas, t'es un "King of Excel"
 
Merci du coup de main

Reply

Sujets relatifs:

Leave a Replay

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