Problème d'execution d'une appli EXCEL

malcom_2004

XLDnaute Nouveau
Bonjour a tous,
avant toute chose, je tiens à préciser que je suis débutant de chez débutant en VB, 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").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 \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").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


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("C1:D32").Clear

'Efface les donnees dans la feuille 4
ThisWorkbook.Worksheets("Feuil4").Range("B1:C8").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


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
 
Dernière édition:

Papou-net

XLDnaute Barbatruc
Re : Problème d'execution d'une appli EXCEL

j'oubliais. si d'autres solutions existent, n'hésitez pas à les poster

MERCI ENCORE

Bonjour malcom_2004, ERIC S,

Petite précision : il n'est jamais indispensable de sélectionner une cellule, ou une plage de cellules, pour les modifier : cela ralentit même l'exécution de la macro.

On peut donc remplacer :

Code:
ThisWorkbook.Worksheets("Feuil4").Range("A" & Ligne).Select
Selection.Value = "OK"

par :

Code:
ThisWorkbook.Worksheets("Feuil4").Range("A" & Ligne).Value = "OK"

Espérant avoir été utile.

Cordialement.
 

malcom_2004

XLDnaute Nouveau
Re : Problème d'execution d'une appli EXCEL

maintenant, j'ai un autre problème
je voudrais ajouter des lignes de données dans mon tableau (feuiile 1) correspondant à l'année 2008. j'ai donc fait un jeu d'essai dans ma BD. De ce coté , tout est OK.
Il faut ensuite modifier le code de mes Macros, et c'est là que ça coince.

Si quelqu'un peut m'aider, ce serait super sympa car là, je galère grave.

P.S: le code de mes Macros est au dessus, avec en modification celle proposée par ERIC S. A ce que je comprends, je pense qu'il y a des modif à faire dans les 2 Macros MAJApporteur et MAJSociete
 

malcom_2004

XLDnaute Nouveau
Re : Problème d'execution d'une appli EXCEL

maintenant, j'ai un autre problème
je voudrais ajouter des lignes de données dans mon tableau (feuiile 1) correspondant à l'année 2008. j'ai donc fait un jeu d'essai dans ma BD. De ce coté , tout est OK.
Il faut ensuite modifier le code de mes Macros, et c'est là que ça coince.

Si quelqu'un peut m'aider, ce serait super sympa car là, je galère grave.

P.S: le code de mes Macros est au dessus, avec en modification celle proposée par ERIC S. A ce que je comprends, je pense qu'il y a des modif à faire dans les 2 Macros MAJApporteur et MAJSociete

Merci encore a tous
 

malcom_2004

XLDnaute Nouveau
Re : Problème d'execution d'une appli EXCEL

maintenant, j'ai un autre problème
je voudrais ajouter des lignes de données dans mon tableau (feuiile 1) correspondant à l'année 2008. j'ai donc fait un jeu d'essai dans ma BD. De ce coté , tout est OK.
Il faut ensuite modifier le code de mes Macros, et c'est là que ça coince.

Si quelqu'un peut m'aider, ce serait super sympa car là, je galère grave.

P.S: le code de mes Macros est au dessus, avec en modification celle proposée par ERIC S. A ce que je comprends, je pense qu'il y a des modif à faire dans les 2 Macros MAJApporteur et MAJSociete

Merci encore a tous
 

Discussions similaires

Réponses
6
Affichages
237

Statistiques des forums

Discussions
312 185
Messages
2 086 020
Membres
103 097
dernier inscrit
Benduch