Discussion :

[Sinclar]

Bonjour,
Je vous soumets un problème pour exporter des données vers xl:

Par exemple avec la requête suivante:

ID_Contact | IDFonction_contact | Fonction_contact | Nom_Contact

Données:
1 | 1 | Assistant | Alain
2 | 1 | Assistant | Jean
3 | 3 | Coordinateur | Etienne
4 | 3 | Coordinateur | Stéphane

Je sais exporter toutes les lignes mais ici je voudrais que le résultat dans xl s'affiche de cette manière:

Assistant
Alain
Jean

Coordinateur
Etienne
Stéphane

Si vous avez une idée...Merci

[Tofalu]

A priori, il s'agit d'un simple parcours de recordset

Tu lis le premier enregistrement, tu mémorises sa fonction, tu l'inscrit dans la première ligne, tu passe à la ligne suivante, tu inscris son nom, tu lis l'enregistrement suivant ... si la fonction est la même tu passes à la ligne suivante et inscrit son nom, sinon, tu sautes une ligne, inscrit sa fonction puis en dessous son nom ...

Ici, je différencie ligne : Ligne Excel et enregistrement : Ligne Access

[Sinclar]

Je reviens sur le sujet; Merci Tofalu, j'ai suivi ta piste mais le problème persiste au niveau de la mémorisation de IDFonction_contact, voilà le code test que j'essaie de faire fonctionner (il s'agit d'un tableau dan word):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
 
Dim Wdapp As Word.Application
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim intcol As Integer
Dim intlig As Integer
Dim i As Integer
 
Set db = CurrentDb()
Set rst = db.OpenRecordset("SELECT * FROM tbl_contact")
Set Wdapp = CreateObject("Word.application")
Wdapp.Visible = True
Wdapp.Documents.Open "C:\Document\TransfertContact.doc"
 
With Wdapp.ActiveDocument.Tables(1)
    intlig = 1
    intcol = 1
    i = rst("IDFonction_contact")
    .Cell(intlig, intcol).Range.Text = i
    intlig = 2
        While Not rst.EOF
            If rst("IDFonction_contact") = i Then
                .Cell(intlig, intcol + 1).Range.Text = rst("Nom_Contact")
            Else
                .Cell(intlig, intcol).Range.Text = i
                i = rst("IDFonction_contact")
                intlig = intlig + 
            End If
        rst.MoveNext
        intlig = intlig + 1
        Wend
End With
...

Merci d'avance...

[coyott]

ce que je ferais sans rentrer dans l'écriture du code (la flemme )
2 recordsets rst1 et rst2

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
 
rst1 : sélectione juste la colonne IDFonction_contact (en regroupement ) pour avoir toutes les idfonction_contact possible (une seule fois)
 
j'ouvre une boucle tant que pas à la fin de rst1
 
   creation de rst2 qui sélectionne les enregistrements de table qui ont    pour idfonctioncontact rst1(idfonctioncontact )
   j'exporte l'idfonction_contact 
   j'exporte les enregistrements de rst2
   fermeture de rst2
   je passe à l'enregistrement suivant de rst1
je boucle

voilà pour le raisonement en espérant que ca t'aideras

[Sinclar]

Ah oui tiens, je n'y avais pas pensé; je me focalisais sur une comparasion des ID_FonctionContact;
Je vais essayer comme ça; Merci beaucoup

[Sinclar]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
 
Private Sub Commande0_Click()
 
Dim Wdapp As Word.Application
Dim db As DAO.Database
Dim rst1 As DAO.Recordset
Dim rst2 As DAO.Recordset
Dim fld As DAO.Field
Dim intcol As Integer
Dim intlig As Integer
 
Set db = CurrentDb()
Set rst1 = db.OpenRecordset("SELECT DISTINCT [IDFonction_contact] FROM tbl_contact")
 
Set Wdapp = CreateObject("Word.application")
Wdapp.Visible = True
Wdapp.Documents.Open "C:\Mes Documents\Transfert tableau.doc"
 
With Wdapp.ActiveDocument.Tables(1)
    intlig = 1
    intcol = 1
        While Not rst1.EOF
        .Cell(intlig, intcol).Range.Text = rst1("IDFonction_contact")
        intlig = intlig + 1
        Set rst2 = db.OpenRecordset("SELECT * FROM tbl_contact WHERE [IDFonction_contact]= " & rst1("IDFonction_contact"))
            While Not rst2.EOF
            .Cell(intlig, intcol + 1).Range.Text = rst2("Nom_Contact")
            rst2.MoveNext
            intlig = intlig + 1
            Wend
            rst2.Close
        rst1.MoveNext
        intlig = intlig + 1
        Wend
End With
Set Wdapp = Nothing
rst1.Close
Set rst1 = Nothing
Set rst2 = Nothing
Set db = Nothing
End Sub

Merci encore à Tofalu et Coyott