Sujet Précédent Sujet Suivant

[Catégorie modifiée VB6 --> VBA] erreur d'execution '3061' Visual basic

cs_oceane13 Messages postés 1 Date d'inscription mercredi 23 juin 2010 Statut Membre Dernière intervention 23 juin 2010 - 23 juin 2010 à 01:59
cs_Jack Messages postés 14006 Date d'inscription samedi 29 décembre 2001 Statut Modérateur Dernière intervention 28 août 2015 - 23 juin 2010 à 13:01
Hello,

je génère des raports à partir d'une macro, mais cette fois si ca ne fonctionne pas...
quelqu'un pourrait-il m'aider ?

le debogage me donne une erreur de compilation dans la dernière boucle

Set Rs2 = Bd.OpenRecordset(RqSQL, dbOpenDynaset)


If Rs2.RecordCount > 0 Then

Merci beaucoup d'avance


'*******************************************************************
'** **
'** Ce module regroupe toutes les fonctions et procédures **
'** portant sur le rapport n°1 : Nouvelles références initiées **
'** Développé par Sébastien Rouillard - Synergie **
'** mars 2010 **
'** **
'*******************************************************************




Sub MajRapport01()
Dim RapportGal As Workbook, RapportFBN As Workbook
Dim CheminFich As String, CheminBd As String, NomBd As String
Dim RqSQL As String
Dim Bd As Database
Dim Rs1 As Recordset, Rs2 As Recordset
Dim I As Long, J As Long, K As Long
Dim DateDebut As String

Application.ScreenUpdating = False



'Initialisation des variables
CheminFich = ThisWorkbook.Path
CheminFich IIf(Right(CheminFich, 1) "", CheminFich, CheminFich & "")
CheminBd = ThisWorkbook.Sheets("Parametres").Cells(1, 2)
CheminBd IIf(Right(CheminBd, 1) "", CheminBd, CheminBd & "")
NomBd = ThisWorkbook.Sheets("Parametres").Cells(2, 2)
DateDebut = InputBox("Entrez la date de début de calcul (aaaa-mm-jj)", "Nouvelles références initiées...")

Set RapportGal = Workbooks.Open(CheminFich & "01. Nouvelles références initiées - Global.xls")
Set RapportFBN = Workbooks.Open(CheminFich & "01. Nouvelles références initiées - FBN.xls")
Set Bd = OpenDatabase(CheminBd & NomBd)



'Réinitialisation de la feuille des données des deux rapports
RapportGal.Sheets("Donnees").Range("A4:Z65536").ClearContents
RapportFBN.Sheets("Donnees").Range("A4:Z65536").ClearContents
RapportGal.Sheets("Donnees").Range("A1") = "Références initiées depuis le " & DateDebut
RapportFBN.Sheets("Donnees").Range("A1") = "Références initiées depuis le " & DateDebut



'Requête d'extraction des données
RqSQL = "SELECT Import.[Numéro de référence], Import.[Référent - Prénom], Import.[Référent - Nom], " & _
"Import.[Référent - Type], Import.[Référent - Transit], Import.[Référent - Code CP], " & _
"Import.[Référé - Prénom], Import.[Référé - Nom], Import.[Référé - Transit], " & _
"Import.[Référé - No# Employé ou Code CP], Import.[Client - Montant opportunité], " & _
"Import.[Date création de la référence], Import.[Référent - Code T2], Import.[Référé - T2], " & _
"Import.[Opportunité - UAR - Commentaire], Import.[Client - Informations utiles] " & _
"FROM Import " & _
"WHERE Import.[Date création de la référence] >= '" & DateDebut & "';"

Set Rs1 = Bd.OpenRecordset(RqSQL, dbOpenDynaset)



'Mise à jour du rapport 01 (rapport général hors FBN et rapport FBN)
If Rs1.RecordCount > 0 Then
I = 4 '1ère ligne d'écriture dans le rapport global
J = 4 '1ère ligne d'écriture dans le rapport FBN
Rs1.MoveFirst
Do While Not Rs1.EOF
'On détermine la filiale du référent (en fonction de son type), ainsi que sa structure hiérarchique
Select Case UCase(Rs1.Fields(3).Value)
Case "BP", "DSF", "DVC", "DVS", "DS", "CFP", "PF", "BGP"
For K = 0 To 11
RapportGal.Sheets("Donnees").Cells(I, K + 1) = Rs1.Fields(K).Value
Next K
RapportGal.Sheets("Donnees").Cells(I, 13) = "Réseau"
RapportGal.Sheets("Donnees").Cells(I, 17) = Rs1.Fields(14).Value & " " & Rs1.Fields(15).Value

RqSQL = "SELECT RA.[PVP], RA.[NomRA], RVS.[NomRVS] " & _
"FROM Transits " & _
"INNER JOIN (RVS " & _
"INNER JOIN RA " & _
"ON RA.[NoRA]=RVS.[ref_NoRA]) " & _
"ON RVS.[NoRVS]=Transits.[ref_NoRVS] " & _
"WHERE Transits.[NoTransit]='" & Rs1.Fields(4).Value & "';"

Set Rs2 = Bd.OpenRecordset(RqSQL, dbOpenDynaset)

If Rs2.RecordCount > 0 Then
RapportGal.Sheets("Donnees").Cells(I, 14) = Rs2.Fields(0).Value
RapportGal.Sheets("Donnees").Cells(I, 15) = ModGlobal.SupprimerNoRef(Rs2.Fields(1).Value)
RapportGal.Sheets("Donnees").Cells(I, 16) = ModGlobal.SupprimerNoRef(Rs2.Fields(2).Value)
End If

Rs2.Close
I = I + 1
Case "BPE", "SBP-SCCP"
For K = 0 To 11
RapportGal.Sheets("Donnees").Cells(I, K + 1) = Rs1.Fields(K).Value
Next K
RapportGal.Sheets("Donnees").Cells(I, 13) = "SBP"
RapportGal.Sheets("Donnees").Cells(I, 17) = Rs1.Fields(14).Value & " " & Rs1.Fields(15).Value
I = I + 1
Case "DCI", "DDE", "DSAE", "DSA", "DTE", "DFA", "DTG", "PFCE"
For K = 0 To 11
RapportGal.Sheets("Donnees").Cells(I, K + 1) = Rs1.Fields(K).Value
Next K
RapportGal.Sheets("Donnees").Cells(I, 5) = Rs1.Fields(12).Value
RapportGal.Sheets("Donnees").Cells(I, 13) = "SAE"
RapportGal.Sheets("Donnees").Cells(I, 17) = Rs1.Fields(14).Value & " " & Rs1.Fields(15).Value

If UCase(Rs1.Fields(3).Value) = "DFA" Then
RapportGal.Sheets("Donnees").Cells(I, 14) = "Jacques Deforges"
RapportGal.Sheets("Donnees").Cells(I, 15) = "Nathalie Lauzier"
RapportGal.Sheets("Donnees").Cells(I, 16) = "Connie Pacifico"
Else
RqSQL = "SELECT StructSAE.[PVP], StructSAE.[Nom_VP], StructSAE.[Nom_DP] " & _
"FROM StructSAE " & _
"WHERE StructSAE.[T2_DC]='" & Rs1.Fields(12).Value & "';"

Set Rs2 = Bd.OpenRecordset(RqSQL, dbOpenDynaset)

If Rs2.RecordCount > 0 Then
RapportGal.Sheets("Donnees").Cells(I, 14) = Rs2.Fields(0).Value
RapportGal.Sheets("Donnees").Cells(I, 15) = Rs2.Fields(1).Value
RapportGal.Sheets("Donnees").Cells(I, 16) = Rs2.Fields(2).Value
End If

Set Rs2 = Nothing
End If
I = I + 1
Case "CP"
For K = 0 To 11
RapportFBN.Sheets("Donnees").Cells(J, K + 1) = Rs1.Fields(K).Value
Next K
RapportFBN.Sheets("Donnees").Cells(J, 13) = "FBN"
RapportFBN.Sheets("Donnees").Cells(J, 17) = Rs1.Fields(14).Value & " " & Rs1.Fields(15).Value

RqSQL = "SELECT RegionsFBN.[PVP], RegionsFBN.[Region], RegionsFBN.[Succursale] " & _
"FROM RegionsFBN " & _
"WHERE RegionsFBN.[Transit]='" & Rs1.Fields(4).Value & "';"




Set Rs2 = Bd.OpenRecordset(RqSQL, dbOpenDynaset)


If Rs2.RecordCount > 0 Then


RapportFBN.Sheets("Donnees").Cells(J, 14) = Rs2.Fields(0).Value
RapportFBN.Sheets("Donnees").Cells(J, 15) = Rs2.Fields(1).Value
RapportFBN.Sheets("Donnees").Cells(J, 16) = Rs2.Fields(2).Value
End If

Rs2.Close
J = J + 1
Case "DDACONST", "DDAMULTI"
For K = 0 To 11
RapportGal.Sheets("Donnees").Cells(I, K + 1) = Rs1.Fields(K).Value
Next K
RapportGal.Sheets("Donnees").Cells(I, 13) = "UDI"
RapportGal.Sheets("Donnees").Cells(I, 17) = Rs1.Fields(14).Value & " " & Rs1.Fields(15).Value
I = I + 1
Case Else
For K = 0 To 11
RapportGal.Sheets("Donnees").Cells(I, K + 1) = Rs1.Fields(K).Value
Next K
RapportGal.Sheets("Donnees").Cells(I, 17) = Rs1.Fields(14).Value & " " & Rs1.Fields(15).Value
I = I + 1
End Select

Rs1.MoveNext
Loop
End If

Set Rs2 = Nothing
Rs1.Close
Set Rs1 = Nothing
Bd.Close
Set Bd = Nothing



RapportGal.Close (True)
RapportFBN.Close (True)

Application.ScreenUpdating = True
End Sub

Oceane13

1 réponse

Réponse 1 / 1
cs_Jack Messages postés 14006 Date d'inscription samedi 29 décembre 2001 Statut Modérateur Dernière intervention 28 août 2015 79
23 juin 2010 à 13:01
Salut
Je soupçonne que c'est à cause du
Set Rs2 = Nothing
placé quelques lignes avant.
Si tu dois t'en resservir plus loin, ferme-le plutôt que de le détruire :
Rs2.Close 

RapportGal.Sheets("Donnees").Cells(I, 16) = Rs2.Fields(2).Value
End If

Set Rs2 = Nothing   ' <===== Ici
End If
I = I + 1
Case "CP"
0

Discussions similaires

Erreur d’exécution 424 : objet requis
luciol8 -
Marion8316 -

7 réponses
Erreur 424 Objet requis Macro Excel
Gagou_c -
chouchouk8917 -

4 réponses
Erreur 424 "Objet requis"
cs_wow59 -
wow59 -

2 réponses
Message d'erreur 424: objet requis
dyjatou92 -
ucfoutu -

7 réponses
Macro envoi de mail : "Erreur 424 : Objet requis"
TITILALA -
cs_Le Pivert -

1 réponse
Rejoignez-nous