RecordSet et transfert Excel sous condition

Résolu
soleil_levant Messages postés 426 Statut Membre -  
soleil_levant Messages postés 426 Statut Membre -
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
Configuration: Windows XP
Firefox 3.0.3

14 réponses

  1. Christounet Messages postés 1272 Date d'inscription   Statut Membre Dernière intervention   1 393
     
    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
  2. soleil_levant Messages postés 426 Statut Membre 32
     
    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
  3. Christounet Messages postés 1272 Date d'inscription   Statut Membre Dernière intervention   1 393
     
    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
  4. soleil_levant Messages postés 426 Statut Membre 32
     
    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
  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. soleil_levant Messages postés 426 Statut Membre 32
     
    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
  7. Christounet Messages postés 1272 Date d'inscription   Statut Membre Dernière intervention   1 393
     
    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
    1. soleil_levant Messages postés 426 Statut Membre 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
  8. soleil_levant Messages postés 426 Statut Membre 32
     
    Thanks a lot Christounet :)

    Je te donnes de ses nouvelles :)

    Encore merci pour ton aide.
    A plus
    0
  9. Christounet Messages postés 1272 Date d'inscription   Statut Membre Dernière intervention   1 393
     
    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
  10. soleil_levant Messages postés 426 Statut Membre 32
     
    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
  11. Christounet Messages postés 1272 Date d'inscription   Statut Membre Dernière intervention   1 393
     
    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
  12. soleil_levant Messages postés 426 Statut Membre 32
     
    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
  13. Christounet Messages postés 1272 Date d'inscription   Statut Membre Dernière intervention   1 393
     
    Bonjour soleil_levant,

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

    A plus
    0
  14. soleil_levant Messages postés 426 Statut Membre 32
     
    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
  15. soleil_levant Messages postés 426 Statut Membre 32
     
    broblem résolut grace à CHRISTOUNET!!

    merci mec!
    0