Probleme recordset excel [Résolu]

[tissam89]

bonjour, j'essaye d'importer une table de donnée access dans un fichier excel.
j'ai crée une requête qui contient un champ nomé nbre et un champ produit.
Maintenant sur excel je veux avoir au dessu de chaque produit le nbre.

j'ai essayé avec ce code,mais il recupére que la derniere valeur de tableau du champ nbre.
Comment réaliser mon besoin svp?

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub Pilote_Click()
    Dim appexcel As Excel.Application
    Dim wbexcel As Excel.Workbook
    Dim rst As Recordset
 
    'J'initialise mes variables
Set appexcel = CreateObject("Excel.Application")
Set rst = CurrentDb.OpenRecordset("Test")
rst.MoveFirst
While Not rst.EOF
With rst
res = .Fields("Nbre")
End With
rst.MoveNext
Wend
appexcel.Visible = True
    Set wbexcel = appexcel.Workbooks.Open("C:\Documents and Settings\p061743\Desktop\Base TLD\monFichier.xls")
    appexcel.Sheets("TEST").Select
    MsgBox res
appexcel.cells(5, 5) = res
 
End Sub

[argyronet]

Bonjour,

Merci de faire un effort et de relire ton message pour le corriger (omissions et fautes, virgules...)

Pour ton problème, utilise la méthode CopyFromRecordset d'un objet Excel.Range.

Argy

[tissam89]

Merci pour votre réponse rapide.
je ne sais pas trop comment l'utiliser.
voila les modifications que j'ai rapporté à mon code

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Private Sub Pilote_Click()
  Dim appexcel As Excel.Application
    Dim wbexcel As Excel.Workbook
    Dim rst As Recordset
    Dim copyFromRecordset As Range
    'J'initialise mes variables
Set appexcel = CreateObject("Excel.Application")
Set rst = CurrentDb.OpenRecordset("Test")
rst.MoveFirst
While Not rst.EOF
With rst
res = .Fields("Nbre")
End With
rst.MoveNext
Wend
appexcel.Visible = True
    Set wbexcel = appexcel.Workbooks.Open("monFichier.xls")
    appexcel.Sheets("TEST").Select
    Range("A1").copyFromRecordset rst
 
 '   MsgBox res
'appexcel.cells(5, 5) = res
 
End Sub

Mais je recoi cette erreur : La méthode range de l'objet global a échoué

[argyronet]

Lorsque l'on utilise OLE automation ainsi que tu le fais, il faut qualifier les objets sinon, tu auras automatiquement cette erreur...

En plus déclarer une variable qui porte le nom d'une méthode n'est pas une bonne idée et surtout risqué. Il faut nommer ses variables et ses objets correctement pour une meilleure lisibilité.

Code :

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
 
Private Sub Pilote_Click()
Dim oAppExcel                                          As Excel.Application
Dim oXLWB                                              As Excel.Workbook
Dim oXLSht                                             As Excel.Worksheet
Dim oXLRng                                             As Excel.Range
Dim oRST                                               As DAO.Recordset
Const FICHIER = "C:\Test\monFichier.xls"
    Set oAppExcel = CreateObject("Excel.Application")
    Set oRST = CurrentDb.OpenRecordset("SELECT * FROM Test")
    With oAppExcel
        .DisplayAlerts = False
        Set oXLWB = .Workbooks.Open(FICHIER)
        With oXLWB
            Set oXLSht = .Worksheets("TEST")
            With oXLSht
                Set oXLRng = .Range("A1")
                With oXLRng
                    .copyFromRecordset oRST
                End With
            End With
            .SaveAs FICHIER
            .Close False
        End With
        .Quit
    End With
    Set oXLRng = Nothing
    Set oXLSht = Nothing
    Set oXLWB = Nothing
    Set oAppExcel = Nothing
    'Ouvre le classeur
    Shell "EXCEL.EXE " & FICHIER, vbNormalFocus
End Sub

Argy

[tissam89]

Merci beaucoup! Il marche tres bien.
Par contre il copie les données verticalement exactement comme dans la table access.
moi je veux qu'il copie les données d'une maniere horisontal ,allant de b2 jusqu'a q2.
Est ce que c'est possible ça?
Voila ce que j'ai essayé, mais ça ne donne rien de différent que le 1er resultat:

Code :

1
2
3
4
5
6
7
8
9
10
11
 With oXLWB
            Set oXLSht = .Worksheets("TEST")
            With oXLSht
                Set oXLRng = .Range("b2 : Q2")
                With oXLRng
                    .copyFromRecordset oRST
                End With
            End With
            .SaveAs "C:\Documents and Settings\p061743\Desktop\Base TLD\Fichier.xls"
            .Close False
        End With

[argyronet]

Eh oui, ça peut pas marcher;
La méthode copyFromRecordset ne veut qu'une cellule de départ.
Si tu veux transposer, il ne faut pas utiliser cette méthode mais un Do Loop dans le RecordSet associé à la propriété Offset de ton objet Range de B (colonne 2) à Q à (colonne 17).

Argy

[tissam89]

Je ne vois pas comment est ce que je peux faire ça.
auriez vous un exemple svp?

[loufab]

Bonjour,

Il y a un exemple dans ce tuto.

http://loufab.developpez.com/tutorie...recherche3fin/

Cordialement,

[argyronet]

Il suffit de lire le RecordSet tel que tu l'as défini.

Code :

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
42
43
44
45
46
 
Private Sub Pilote_Click()
Dim oAppExcel                                          As Excel.Application
Dim oXLWB                                              As Excel.Workbook
Dim oXLSht                                             As Excel.Worksheet
Dim oXLRng                                             As Excel.Range
Dim oRST                                               As DAO.Recordset
Dim C                                                  As Integer
Const FICHIER = "C:\Test\monFichier.xls"
    'Zéro décalage au départ
    C = -1
    Set oAppExcel = CreateObject("Excel.Application")
    Set oRST = CurrentDb.OpenRecordset("SELECT * FROM Test")
    With oAppExcel
        .DisplayAlerts = False
        Set oXLWB = .Workbooks.Open(FICHIER)
        With oXLWB
            Set oXLSht = .Worksheets("TEST")
            With oXLSht
                Set oXLRng = .Range("B2")
                With oXLRng
                    .Select
                    With oRST
                        Do While Not .EOF
                            C = C + 1
                            oXLRng.Offset(0, C).Value = .Fields(0).Value
                            .MoveNext
                        Loop
                        .Close
                    End With
 
                End With
            End With
            .SaveAs FICHIER
            .Close False
        End With
        .Quit
    End With
    Set oXLRng = Nothing
    Set oXLSht = Nothing
    Set oXLWB = Nothing
    Set oAppExcel = Nothing
    Set oRST = Nothing
    'Ouvre le classeur
    Shell "EXCEL.EXE " & FICHIER, vbNormalFocus
End Sub

Fields(0) est le champ de la première colonne de ta table Test.

Argy

[tissam89]

ça marche tres bien.
Merci beaucoup pour votre aide .