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