RecordSet et transfert Excel sous condition
Résolu
soleil_levant
Messages postés
393
Date d'inscription
Statut
Membre
Dernière intervention
-
soleil_levant Messages postés 393 Date d'inscription Statut Membre Dernière intervention -
soleil_levant Messages postés 393 Date d'inscription Statut Membre Dernière intervention -
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
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:
- RecordSet et transfert Excel sous condition
- Excel cellule couleur si condition texte - Guide
- Word et excel gratuit - Guide
- Liste déroulante excel - Guide
- Si et excel - Guide
- Déplacer colonne excel - Guide
14 réponses
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
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
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
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,
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,
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
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
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.
j'ai emplyé une variable tableau elle me semblais utile mais ça plante :(
Merci infiniment.
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
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
Désolé j'aurais pu détaillé mon code avec plus de détails et commentaires ..
Merci encore
Bonjour soleil_levant,
Alors, une nouvelle version du code
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
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
Bonjour soleil_levant,
Petite faute dans mon code, il faut remplacer
Je l'ai testé sur ma base de données (pas les mêmes requêtes) et cela fonctionne.
A plus
Petite faute dans mon code, il faut remplacer
Wsheet.Cells(i + 2, j + 1).Value = rs_resultat(j).Valuepar
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
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
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
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
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
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 :)
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 :)
Bonjour soleil_levant,
Je pense qu'il te manque la définition suivante
A plus
Je pense qu'il te manque la définition suivante
DIM rs_resultat As DAO.Recordset
A plus
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
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