Re : question concernant une Macro Excel
Bonjour tototiti2008 et merci de ta réponse
apparamment, NomRequete est juste un "string" dans la macro, ce n'est pas une de mes requetes dans ma BD Access
voici l'intégralité de ma Macro Excel :
Function MAJAuxSoc(NomRequete As String, Donnee As String, db As Database)
'Dim app As Access.Application
Dim qdf As QueryDef
'Dim qdfDel As QueryDef
Dim rs As Recordset
Dim Annee As Integer
Dim PrimA As Double
Dim PrimAT As Double
Dim SP As Double
Dim SPT As Double
Dim SPF As Double
Dim SP30k As Double
Dim SP30kT As Double
Dim SP30kF As Double
PrimAT = 0
SPT = 0
SPF = 0
SP30kT = 0
SP30kF = 0
Set qdf = db.QueryDefs(NomRequete)
Set rs = qdf.OpenRecordset(dbOpenForwardOnly, dbReadOnly)
While rs.EOF = False And rs.BOF = False
Annee = rs![Exercice]
PrimA = rs!["Montant des primes acquises"]
PrimAT = PrimAT + PrimA
SP = rs![SP] / 100
SPT = SPT + SP * PrimA
SP30k = rs![SPDec] / 100
SP30kT = SP30kT + SP30k * PrimA
db.Execute ("INSERT INTO SORTIESoc ( Donnee , Annee, SP, SP30k ) VALUES ('" & Donnee & "','" & Annee & "','" & SP & "','" & SP30k & "')")
rs.MoveNext
Wend
'Correction SPTOT et SP30kTOT
SPF = SPT / PrimAT
SP30kF = SP30kT / PrimAT
ChercheLigneVide
Selection.Value = Donnee
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.Value = SPF
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.Value = SP30kF
Set rs = Nothing
Set qdf = Nothing
End Function
Sub MAJSoc()
'MsgBox "Mise à jour de la feuille pour les données Société "
Dim db As Database
Dim rs As Recordset
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_SPSoc_SPDecSoc par annee"
TabDonnee(2, 1) = "SP_AUTO"
TabDonnee(2, 2) = "Etat_SPSoc_SPDecSoc AUTO par annee"
TabDonnee(3, 1) = "SP_AUTO_rc"
TabDonnee(3, 2) = "Etat_SPSoc_SPDecSoc AUTO_respciv par annee"
TabDonnee(4, 1) = "SP_AUTO_dommage"
TabDonnee(4, 2) = "Etat_SPSoc_SPDecSoc AUTO_dommage par annee"
TabDonnee(5, 1) = "SP_INCENDIE"
TabDonnee(5, 2) = "Etat_SPSoc_SPDecSoc INCENDIE par annee"
TabDonnee(6, 1) = "SP_INCENDIE_mrh"
TabDonnee(6, 2) = "Etat_SPSoc_SPDecSoc INCENDIE_MRH par annee"
TabDonnee(7, 1) = "SP_INCENDIE_mac"
TabDonnee(7, 2) = "Etat_SPSoc_SPDecSoc INCENDIE_MAC par annee"
TabDonnee(8, 1) = "SP_RD"
TabDonnee(8, 2) = "Etat_SPSoc_SPDecSoc RD par annee"
Set db = OpenDatabase("\\Chy11\commun\Malik Rapport SP\rapport SP\Traitement SP\rapport_sp_042009.mdb")
Set qdfDel = db.QueryDefs("DELETE_SortieSoc")
'Efface les donnees dans Sortie
qdfDel.Execute
'Efface les donnees dans la feuille 3
ThisWorkbook.Sheets("Feuil3").Shapes.SelectAll
Selection.Delete
ThisWorkbook.Sheets("Feuil3").Cells.Clear
'Efface les donnees dans la feuille 4
ThisWorkbook.Worksheets("Feuil4").Shapes.SelectAll
Selection.Delete
ThisWorkbook.Worksheets("Feuil4").Cells.Clear
'Appel la fonction de remplissage de Sorie
For i = 1 To 8
MAJAuxSoc TabDonnee(i, 2), TabDonnee(i, 1), db
Next i
'Met la feuille3 a jour
Set rs = db.OpenRecordset("SortieSoc", dbOpenTable)
ThisWorkbook.Worksheets("Feuil3").Range("A1").CopyFromRecordset rs
db.Close
Set db = Nothing
Set rs = Nothing
Set qdfDel = Nothing
'MsgBox "Mise à jour effectuée avec succès!"'
End Sub
le code en rouge correspond à l'endroit ou ma macro bloque
Merci d'avance
Malcom