Bonjour a tous,
avant toute chose, je tiens à préciser que je suis débutant de chez débutant en VB et que l'appl dont je vais parler à été développée par une personne qui n'est plus dans la société ou je travaille actuellement. Donc ne soyez pas surpris si je pose des questions que bcp d'entres vous trouveront betes voire naives
Voilà, j'ai un gros soucis concernant une Appli EXCEL dont le but est de remplir un tableau en faisant appel à une BD Access (certains champs sont pris de la BD tels quels, d'autres nécessitent de petits calculs).
En exécutant la Macro, j'ai l'erreur suivante:
"Erreur d'exécution 2004", la méthode "Select" de la classe "Range" a échoué.
en cliquant sur "débogage", la ligne suivante est surligné en jaune:
ThisWorkbook.Worksheets("Feuil4" ).Range("A" & Ligne).Select
Peut etre que la copie des macros en entier pourront vous aider a mieux comprendre le problème. J'y viens.
Mon appli a 4 feuilles, la feuille 1 est la principale (avec 4 boutons + le tableau qui est censé se remplir), les 3 autres étant des tableaux qui se remplissent au moment de l'exécution des Macros.
Le 1er bouton (MAJ Données Apporteurs) fonctionnent correctement. La Macro associée (MAJApporteur) me semble donc bonne.
Le 2ème bouton (MAJ Données Société) ne FONCTIONNE PAS. C'est là l'objet de mon poste, et c'est là que j'obtiens l'erreur cité précédemment. J'ai remarqué que la Macro associée (appelée MAJSociete) utilise des fonctions codées sur une 3è Macro (appelée Util)
Si une ame charitable pouvait jeter un coup d'oeil sur le code que je vais copier + bas, ce serait super sympa de votre part.
Merci encore à tous ceux d'avoir lu mon post jusqu'en bas, et à ceux qui pourrait m'aider (vu le niveau de certains sur ce forum, je n'en doute pas).
Malcom
P.S: voici le code de mes 3 Macros
MAJApporteur (celle-ci fonctionne mais on ne sais jamais, ça peut aider)
Function MAJAux(NomRequete As String, Donnee As String, Apporteur As String, db As Database)
'Dim app As Access.Application
Dim qdf As QueryDef
'Dim qdfDel 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)
'MsgBox Nbrs(rs)
'Correction pble lorsqu'une année n'existe pas pour un apporteur
If Nbrs(rs) = 0 Then
For i = 2004 To 2007
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 2007
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 rs.EOF Then db.Execute ("INSERT INTO Sortie ( Donnee ,Apporteur, Annee, PrimeAcquise, SP, SP30k ) VALUES ('" & Donnee & "','" & Apporteur & "','" & i & "','0','0','0')" )
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" ).Val ue
'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 \BD.mdb" )
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" ).Copy FromRecordset 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" ).Valu e = rsi![Site de rattachement]
ThisWorkbook.Worksheets("Feuil1" ).Range("G10" ).Val ue = rsi![Type Apporteur]
ThisWorkbook.Worksheets("Feuil1" ).Range("C8" ).Valu e = 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
MAJSociete
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("\\chemin de la base \BD.mdb" )
Set qdfDel = db.QueryDefs("DELETE_SortieSoc" )
'Efface les donnees dans Sortie
qdfDel.Execute
'Efface les donnees dans la feuille 3
ThisWorkbook.Worksheets("Feuil3" ).Range("C132" ). Clear
'Efface les donnees dans la feuille 4
ThisWorkbook.Worksheets("Feuil4" ).Range("B1:C8" ).C lear
'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" ).Copy FromRecordset rs
db.Close
Set db = Nothing
Set rs = Nothing
Set qdfDel = Nothing
'MsgBox "Mise à jour effectuée avec succès!"
End Sub
Util
Function ChercheLigneVide()
Dim Ligne As Integer
Ligne = 1
While ThisWorkbook.Worksheets("Feuil4" ).Range("A" & Ligne) <> ""
Ligne = Ligne + 1
Wend
ThisWorkbook.Worksheets("Feuil4" ).Range("A" & Ligne).Select
'Selection.Value = "OK"
End Function
Function Nbrs(rs As Recordset)
If rs.EOF Then
Nbrs = 0
Else
rs.MoveLast
Nbrs = rs.RecordCount
rs.MoveFirst
End If
End Function
j'ai remis en gras le code sur lequel la Macro bloque
Merci Encore
