RecordSet et transfert Excel sous condition

Résolu/Fermé
soleil_levant Messages postés 393 Date d'inscription lundi 15 septembre 2008 Statut Membre Dernière intervention 14 avril 2011 - 7 août 2009 à 11:43
soleil_levant Messages postés 393 Date d'inscription lundi 15 septembre 2008 Statut Membre Dernière intervention 14 avril 2011 - 10 août 2009 à 16:06
Bonjour,
HELP!! C'est la cata!! J'ai développé une procédure qui récupère les données d'un RecordSet1, les lance à travers une requete paramétré et ensuite les copies dans une fichier Excel, si une colonne d'un RecordSet change, alors j'écris dans un autre fichier, sinon je continue dans le meme fichier(j'ajoute une feuille). Le problème c'est dans ma boucle dont sa variable est Tableau. Je pense c'est de la qui vient le problème !! Help

Voici ma procédure (je l'ai modifié avec l'application Access, elle execute une procédure SQL Server, mais c'est le meme principe)

On Error Resume Next

Dim db As DAO.Database, qdf_source As DAO.QueryDef, rs_source As DAO.Recordset

Dim qdf_resultat As DAO.QueryDef, rs_resultat As DAO.Recordset
Dim xls As Excel.Application
Dim i As Integer, j As Integer, k As Integer, l As Integer
Dim val1 As String

Set db = CurrentDb
Set qdf_source = db.QueryDefs("REQUETE_RECHERCHE_CLIENT")
Set rs_source = qdf_source.OpenRecordset
rs_source.MoveFirst 'par précaution pointer au début

Dim REF() As String
Dim a As Integer, b As Integer, c As Integer

a = rs_source.RecordCount
ReDim REF(a)

For a = 0 To rs_source.RecordCount - 1


If Not (rs_source.EOF) Then

val1 = rs_source.Fields(1)
REF(a) = rs_source.Fields(0)

Set qdf_resultat = db.QueryDefs("P_Client")
qdf_resultat.Parameters("Nom_Client") = val1
Set rs_resultat = qdf_resultat.OpenRecordset

'Procédure Envoie recodset
Dim createExcel As New Excel.Application
Dim Wbook As Excel.Workbook
Dim Wsheet As Excel.Worksheet
Set Wbook = createExcel.Workbooks.Add
Set Wsheet = Wbook.Worksheets(1)
For i = 0 To rs_resultat.Fields.Count - 1

Wsheet.Cells(1, i + 1).Value = rs_resultat.Fields(i).Name
Wsheet.Cells.Range("A1:AQ1").Interior.ColorIndex = 36
Next i

If (rs_resultat.RecordCount > 0) Then
rs_resultat.MoveFirst
For i = 0 To rs_resultat.Fields.Count - 1
For j = 0 To rs_resultat.Fields.Count - 1
Wsheet.Cells(i + 2, j + 1).Value = rs_resultat(j).Value
Next j
rs_resultat.MoveNext
Next i
End If

rs_source.MoveNext
Set Wsheet = Nothing


REF(a + 1) = rs_source.Fields(0)

ElseIf (Not (rs_source.EOF) & REF(a + 1) = REF(a)) Then 'ECRITURE DANS LE MEME FICHIER
val1 = rs_source.Fields(1)
Set qdf_resultat = db.QueryDefs("P_Client")
qdf_resultat.Parameters("Nom_Client") = val1
Set rs_resultat = qdf_resultat.OpenRecordset

Set Wsheet = Wbook.Worksheets.Add
For i = 0 To rs_resultat.Fields.Count - 1

Wsheet.Cells(1, i + 1).Value = rs_resultat.Fields(i).Name
Wsheet.Cells.Range("A1:AQ1").Interior.ColorIndex = 36
Next i

If (rs_resultat.RecordCount > 0) Then
rs_resultat.MoveFirst
For i = 0 To rs_resultat.Fields.Count - 1
For j = 0 To rs_resultat.Fields.Count - 1
Wsheet.Cells(i + 2, j + 1).Value = rs_resultat(j).Value
Next j
rs_resultat.MoveNext
Next i
End If

Wbook.SaveAs Filename:="C:\Essaies_Files\REPONSE" & val1 & ".xls"
Wbook.Close True
Set createExcel = Nothing
Set Wsheet = Nothing
rs_source.MoveNext

REF(a + 2) = rs_source.Fields(0)

ElseIf (Not (rs_source.EOF) & REF(a + 2) <> REF(a + 1)) Then



ElseIf rs_source.EOF Then


Exit For
End If

Next a

qdf_resultat.Close
rs_resultat.Close

qdf_source.Close
rs_source.Close


Une idée??

Merci d'avance
A voir également:

14 réponses

Christounet Messages postés 1264 Date d'inscription mercredi 26 septembre 2007 Statut Membre Dernière intervention 29 juillet 2010 1 391
7 août 2009 à 14:29
Bonjour soleil_levant,

Tout d'abord voyons si j'ai bien compris ce que tu veux faire avec ce code, tu lis un premier recordset et tant que le Nom_Client est le même tu veux mettre les résultats d'un second recordset dans le même fichier Excel.
Tout d'abord, vérifies que ta première requête est triée sur Nom_client.

Le code ci-dessous devrait faire ce que tu veux, en fait je n'ai plus qu'une seule boucle et j'utilises deux variables val1 et val2. Val1 contient la valeur de l'enregistrement précédent et val2 celui de l'enregistrement courant, sauf lors de la lecture du premier enregistrement où val1 et val2 ont la même valeur
Dim i As Integer, j As Integer, k As Integer, l As Integer
Dim val1 As String
Dim val2 As String

Dim createExcel As New Excel.Application
Dim Wbook As Excel.Workbook
Dim Wsheet As Excel.Worksheet

Set db = CurrentDb
Set qdf_source = db.QueryDefs("REQUETE_RECHERCHE_CLIENT")
Set rs_source = qdf_source.OpenRecordset
rs_source.MoveFirst 'par précaution pointer au début

Dim REF() As String
Dim a As Integer, b As Integer, c As Integer

For a = 0 To rs_source.RecordCount - 1
	If (a = 0) Then
		val1 = rs_source.Fields(1)
	End If
	
	val2 = rs_source.Fields(1)
	
	If (val1 <> val2) Then
		Wbook.SaveAs Filename:="C:\Essaies_Files\REPONSE" & val1 & ".xls"
		Wbook.Close True
		Set createExcel = Nothing
		Set Wsheet = Nothing
		val1 = val2
	End If
	Set qdf_resultat = db.QueryDefs("P_Client")
	qdf_resultat.Parameters("Nom_Client") = val1
	Set rs_resultat = qdf_resultat.OpenRecordset
	Set Wbook = createExcel.Workbooks.Add
	Set Wsheet = Wbook.Worksheets(1)
	If (rs_resultat.RecordCount > 0) Then
		rs_resultat.MoveFirst
		For i = 0 To rs_resultat.Fields.Count - 1
			Wsheet.Cells(1, i + 1).Value = rs_resultat.Fields(i).Name
		Next i
		Wsheet.Cells.Range("A1:AQ1").Interior.ColorIndex = 36
		For i = 0 To rs_resultat.RecordCount - 1
			For j = 0 To rs_resultat.Fields.Count - 1
				Wsheet.Cells(i + 2, j + 1).Value = rs_resultat(j).Value
			Next j
			rs_resultat.MoveNext
		Next i
	End If
	qdf_resultat.Close
	rs_resultat.Close
	Set Wsheet = Nothing
	rs_source.MoveNext
Next a

Wbook.SaveAs Filename:="C:\Essaies_Files\REPONSE" & val1 & ".xls"
Wbook.Close True
Set createExcel = Nothing
Set Wsheet = Nothing

qdf_source.Close
rs_source.Close

J'ai aussi changé ta boucle i sur le recordset rs_resultat de rs_resultat.Fields.Count vers rs_resultat.RecordCount

J'ai pas testé mais du point de vue logique, je pense que le code est correct.

A plus
0
soleil_levant Messages postés 393 Date d'inscription lundi 15 septembre 2008 Statut Membre Dernière intervention 14 avril 2011 32
7 août 2009 à 14:42
Re-Salut Christounet,
Merci pour ta réponse.

En fait, voici à quoi dois ressembler mon RecordSet rs_source:
Fields(0) Fields(1) Fields(2)

RJ01 DUPONT MARC
RJ01 MARTIN JULIEN
RJ02 MARTIN MARC
.....

Tant que mon Fields(0) ne change pas, j'écris dans le mm fichier, dès que ça change, j'écris dans autre fichier, je suis dans ce dernier, si la référence change par rapport celle d'avant, j'écris ailleur (nouveau fichier) etc... jusqu'à la fin du rs_source.

Ma requête RECHERCHE Client est bien trié selon la référence.

Merci infiniment,
0
Christounet Messages postés 1264 Date d'inscription mercredi 26 septembre 2007 Statut Membre Dernière intervention 29 juillet 2010 1 391
7 août 2009 à 14:52
Bonjour soleil_levant,

Juste encore deux petites questions et après je te donne le code corrigé:
1°) dans le nom de ton fichier Excel, tu dois avoir selon ton exemple RJ01 , ensuite RJ02, .... ?
2°) tu dois avoir une feuille par client, dans ton exemple DUPONT, MARTIN, .... ?

A plus
0
soleil_levant Messages postés 393 Date d'inscription lundi 15 septembre 2008 Statut Membre Dernière intervention 14 avril 2011 32
7 août 2009 à 14:56
Le nom de mon fichier Excel peut avoir le nom de la référence, si je traite les ligne ayant la mm référence, alors je mettrai la variable dans le nom de fichier, et le résultat du recordset dans le meme fichier ayant la meme reference si cette référence ne change pas, si elle change alors je change de nom de fichier oui et continue à écrire tant que la référence ne change pas.

j'ai emplyé une variable tableau elle me semblais utile mais ça plante :(

Merci infiniment.
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
soleil_levant Messages postés 393 Date d'inscription lundi 15 septembre 2008 Statut Membre Dernière intervention 14 avril 2011 32
7 août 2009 à 15:05
Autre précision, j'affecte le Fields(1) (nom du client qui se trouve dans le recodset rs_source) dans ma requete paramétrée, j'effectue le test sur la valeur REF du rs_source, si elle change pas, j'écris le rs_resultat (recodset du la requete parémétré) dans le meme fichier, je retourne ensuite vers rs_source.MoveNext, je fais la meme manip...

Désolé j'aurais pu détaillé mon code avec plus de détails et commentaires ..

Merci encore
0
Christounet Messages postés 1264 Date d'inscription mercredi 26 septembre 2007 Statut Membre Dernière intervention 29 juillet 2010 1 391
7 août 2009 à 15:16
Bonjour soleil_levant,

Alors, une nouvelle version du code
Dim db As DAO.Database, qdf_source As DAO.QueryDef, rs_source As DAO.Recordset

Dim qdf_resultat As DAO.QueryDef, rs_resultat As DAO.Recordset
Dim xls As Excel.Application
Dim i As Integer, j As Integer, k As Integer, l As Integer
Dim val1 As String
Dim val2 As String

Dim createExcel As New Excel.Application
Dim Wbook As Excel.Workbook
Dim Wsheet As Excel.Worksheet

Set db = CurrentDb
Set qdf_source = db.QueryDefs("REQUETE_RECHERCHE_CLIENT")
Set rs_source = qdf_source.OpenRecordset
rs_source.MoveFirst 'par précaution pointer au début

Dim REF() As String
Dim a As Integer, b As Integer, c As Integer

a = rs_source.RecordCount

For a = 0 To rs_source.RecordCount - 1
	If (a = 0) Then
		val1 = rs_source.Fields(0)
		Set Wbook = createExcel.Workbooks.Add
	End If
	
	val2 = rs_source.Fields(0)
	
	If (val1 <> val2) Then
		Wbook.SaveAs Filename:="C:\Essaies_Files\REPONSE" & val1 & ".xls"
		Wbook.Close True
		Set Wbook = Nothing
		Set Wsheet = Nothing
		val1 = val2
		Set Wbook = createExcel.Workbooks.Add
	End If
	Set qdf_resultat = db.QueryDefs("P_Client")
	qdf_resultat.Parameters("Nom_Client") = rs.source.Fields(1)
	Set rs_resultat = qdf_resultat.OpenRecordset
	If (rs_resultat.RecordCount > 0) Then
		Set Wsheet = Wbook.Worksheets.Add
		Wsheet.name = rs.source.Fields(1)
		rs_resultat.MoveFirst
		For i = 0 To rs_resultat.Fields.Count - 1
			Wsheet.Cells(1, i + 1).Value = rs_resultat.Fields(i).Name
		Next i
		Wsheet.Cells.Range("A1:AQ1").Interior.ColorIndex = 36
		For i = 0 To rs_resultat.RecordCount - 1
			For j = 0 To rs_resultat.Fields.Count - 1
				Wsheet.Cells(i + 2, j + 1).Value = rs_resultat(j).Value
			Next j
			rs_resultat.MoveNext
		Next i
		Set Wsheet = Nothing
	End If
	qdf_resultat.Close
	rs_resultat.Close
	rs_source.MoveNext
Next a

Wbook.SaveAs Filename:="C:\Essaies_Files\REPONSE" & val1 & ".xls"
Wbook.Close True
Set Wbook = Nothing
Set Wsheet = Nothing
qdf_source.Close
rs_source.Close

Ce code va créer un nouveau classeur à chaque fois que la référence change (Fields(0)), et dans le classeur va créer une nouvelle feuille pour chaque Fields(1) en donnant comme nom la valeur de cette zone.
Il ne te restes plus qu'à testé.
A plus
0
soleil_levant Messages postés 393 Date d'inscription lundi 15 septembre 2008 Statut Membre Dernière intervention 14 avril 2011 32
7 août 2009 à 15:32
Re Christounet,

Code Erreur 424 (Objet Requis), Objet Requis, je pense que tu appel deux fois l'application Excel? Je sais pas..
Merci encore
0
soleil_levant Messages postés 393 Date d'inscription lundi 15 septembre 2008 Statut Membre Dernière intervention 14 avril 2011 32
7 août 2009 à 15:21
Thanks a lot Christounet :)

Je te donnes de ses nouvelles :)

Encore merci pour ton aide.
A plus
0
Christounet Messages postés 1264 Date d'inscription mercredi 26 septembre 2007 Statut Membre Dernière intervention 29 juillet 2010 1 391
7 août 2009 à 15:58
Bonjour soleil_levant,

Petite faute dans mon code, il faut remplacer
Wsheet.Cells(i + 2, j + 1).Value = rs_resultat(j).Value
par
Wsheet.Cells(i + 2, j + 1).Value = rs_resultat.Fields(j).Value

Je l'ai testé sur ma base de données (pas les mêmes requêtes) et cela fonctionne.

A plus
0
soleil_levant Messages postés 393 Date d'inscription lundi 15 septembre 2008 Statut Membre Dernière intervention 14 avril 2011 32
7 août 2009 à 16:17
Merci encore une fois

Je l'ai déja corrigé cette petite erreur de saisie, il y avais aussi une niveau rs.Source

tjrs la meme erreur 424 (objet requis)
Mais me semble que quand tu appel l'application Excel, tu l'appel deux fois
............
Dim a As Integer, b As Integer, c As Integer

a = rs_source.RecordCount

For a = 0 To rs_source.RecordCount - 1
If (a = 0) Then
val1 = rs_source.Fields(0) '<<===Ici tu affecte la valeur à la variable
Set Wbook = createExcel.Workbooks.Add
End If

val2 = rs_source.Fields(0)

If (val1 <> val2) Then
Wbook.SaveAs Filename:="C:\Essaies_Files\REPONSE" & val1 & ".xls"
Wbook.Close True
Set Wbook = Nothing
Set Wsheet = Nothing
val1 = val2 '<<=== Tu affecte de nouveau la variable différemment dans la meme portée
Set Wbook = createExcel.Workbooks.Add
End If
Set qdf_resultat = db.QueryDefs("P_Client")
qdf_resultat.Parameters("Nom_Client") = rs_source.Fields(1)
Set rs_resultat = qdf_resultat.OpenRecordset
If (rs_resultat.RecordCount > 0) Then
Set Wsheet = Wbook.Worksheets.Add
Wsheet.Name = rs.Source.Fields(1)
rs_resultat.MoveFirst
For i = 0 To rs_resultat.Fields.Count - 1
Wsheet.Cells(1, i + 1).Value = rs_resultat.Fields(i).Name
..........

Regarde mes commentaires '<<====

je pense c'est de la d'ou viens le problèmes.

Merci
0
Christounet Messages postés 1264 Date d'inscription mercredi 26 septembre 2007 Statut Membre Dernière intervention 29 juillet 2010 1 391
7 août 2009 à 16:28
Bonjour soleil_levant,

Si tu lis bien le code, tu verras que je n'affecte la valeur val1 que lorsque tu es sur le premier enregistrement du recordset rs_source ---> IF (a = 0), sinon j'affecte toujours la valeur de l'enregistrement courant à val2.
Ensuite, je change la valeur de val1 que si et seulement si val1 n'est pas égal à val2 ---> (if val1 <> val2) et comme je te l'ai dis dans mon message précédent, j'ai testé le code et je n'ai plus eu d'erreurs. Peux-tu copier/coller ton code complet stp ?
A plus
0
soleil_levant Messages postés 393 Date d'inscription lundi 15 septembre 2008 Statut Membre Dernière intervention 14 avril 2011 32
7 août 2009 à 16:46
Re, Voici mon code :

On Error GoTo Err_Handler
Dim db As DAO.Database, qdf_source As DAO.QueryDef, rs_source As DAO.Recordset

Dim qdf_resultat As DAO.QueryDef, rs_resultat As DAO.Recordset
Dim xls As Excel.Application
Dim i As Integer, j As Integer, k As Integer, l As Integer
Dim val1 As String
Dim val2 As String

Dim createExcel As New Excel.Application
Dim Wbook As Excel.Workbook
Dim Wsheet As Excel.Worksheet

Set db = CurrentDb
Set qdf_source = db.QueryDefs("REQUETE_RECHERCHE_CLIENT")
Set rs_source = qdf_source.OpenRecordset
rs_source.MoveFirst 'par précaution pointer au début

Dim REF() As String
Dim a As Integer, b As Integer, c As Integer

a = rs_source.RecordCount

For a = 0 To rs_source.RecordCount - 1
If (a = 0) Then
val1 = rs_source.Fields(0)
Set Wbook = createExcel.Workbooks.Add
End If

val2 = rs_source.Fields(0)

If (val1 <> val2) Then
Wbook.SaveAs Filename:="C:\Essaies_Files\REPONSE" & val1 & ".xls"
Wbook.Close True
Set Wbook = Nothing
Set Wsheet = Nothing
val1 = val2
Set Wbook = createExcel.Workbooks.Add
End If
Set qdf_resultat = db.QueryDefs("P_Client")
qdf_resultat.Parameters("Nom_Client") = rs_source.Fields(1)
Set rs_resultat = qdf_resultat.OpenRecordset
If (rs_resultat.RecordCount > 0) Then
Set Wsheet = Wbook.Worksheets.Add
Wsheet.Name = rs.Source.Fields(1)
rs_resultat.MoveFirst
For i = 0 To rs_resultat.Fields.Count - 1
Wsheet.Cells(1, i + 1).Value = rs_resultat.Fields(i).Name
Next i
Wsheet.Cells.Range("A1:AQ1").Interior.ColorIndex = 36
For i = 0 To rs_resultat.RecordCount - 1
For j = 0 To rs_resultat.Fields.Count - 1
Wsheet.Cells(i + 2, j + 1).Value = rs_resultat.Fields(j).Value
Next j
rs_resultat.MoveNext
Next i
Set Wsheet = Nothing
End If
qdf_resultat.Close
rs_resultat.Close
rs_source.MoveNext
Next a

Wbook.SaveAs Filename:="C:\Essaies_Files\REPONSE" & val1 & ".xls"
Wbook.Close True
Set Wbook = Nothing
Set Wsheet = Nothing
qdf_source.Close
rs_source.Close

Err_Handler:

MsgBox Err.Number & " " & Err.Description


Merci infiniment :)
0
Christounet Messages postés 1264 Date d'inscription mercredi 26 septembre 2007 Statut Membre Dernière intervention 29 juillet 2010 1 391
7 août 2009 à 17:03
Bonjour soleil_levant,

Je pense qu'il te manque la définition suivante
DIM rs_resultat As DAO.Recordset

A plus
0
soleil_levant Messages postés 393 Date d'inscription lundi 15 septembre 2008 Statut Membre Dernière intervention 14 avril 2011 32
8 août 2009 à 14:53
Bonjour Christounet,

J'espère que je te dérange pas en ce samedi :)

J'ai une question, si je meettai des étapes dans mon code, comme le vieu temps au lycée on étudiais le cobol, tu sais si des conditions sont toujours vrais, on revois vers une étape, voici l'exemple, apparemment ça marche avec VBA:

1 Ouverture d'un nouveau classeur..
2 Ecriture dans le classeur ouvert
..
If val1 = val2 Then Go To 2
...
If val1 <> val2 Then GoTo 1
Else Exit

Enfin le principe est de renvoyer à des étapes ..

Merci et bon weekend
0
soleil_levant Messages postés 393 Date d'inscription lundi 15 septembre 2008 Statut Membre Dernière intervention 14 avril 2011 32
10 août 2009 à 16:06
broblem résolut grace à CHRISTOUNET!!

merci mec!
0