Erreur 13 lors de l'exportation de plusieurs requêtes d'access vers excel

**ETLVAMS** · 13/06/2016, 09h46

Bonjour à tous,

Je veux exporter plusieurs requêtes dans plusieurs fichiers Excel j'utilise le code suivant, mais ça m'affiche erreur 13 au niveau de ExportFeuille xlSheet, rec. Quelqu'un aurait-il une solution ?

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
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
Function TransfertExcelAutomation1()
Dim xlApp           As Excel.Application
Dim xlSheet         As Excel.Worksheet
Dim xlBook          As Excel.Workbook
Dim t0 As Single
Dim rec As DAO.Recordset
 
    t0 = Timer
    'Initialisations
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
    'Ajouter une feuille de calcul
    Set xlSheet = xlBook.Worksheets.Add
    xlSheet.Name = "Tutor1"
    Set rec = CurrentDb.OpenRecordset("Reqeaug", dbOpenSnapshot)
    ' le titre1
    ' écriture dans la cellule de ligne 1 et de colonne 1
    xlSheet.Cells(1, 1) = "Première Structure des donées"
    ExportFeuille xlSheet, rec
    '''''''''''''''''
    '''''''''''''''''
    Set xlSheet = xlBook.Worksheets.Add
    xlSheet.Name = "Tutor2"
    Set rec = CurrentDb.OpenRecordset("Vapeureau", dbOpenSnapshot)
    ' le titre2
    ' écriture dans la cellule de ligne 1 et de colonne 1
    xlSheet.Cells(1, 1) = "Deuxième Structure des donées"
    ExportFeuille xlSheet, rec
    rec.Close
    '''''''''''''''''
    Set xlSheet = xlBook.Worksheets.Add
    xlSheet.Name = "Tutor3"
    Set rec = CurrentDb.OpenRecordset("pptesCO2", dbOpenSnapshot)
    ' le titre3
    ' écriture dans la cellule de ligne 1 et de colonne 1
    xlSheet.Cells(1, 1) = " Troisième Structure des donées"
    ExportFeuille xlSheet, rec
    '''''''''''''''''
    Set xlSheet = xlBook.Worksheets.Add
    xlSheet.Name = "Tutor4"
    Set rec = CurrentDb.OpenRecordset("pptésair", dbOpenSnapshot)
    ' le titre4
    ' écriture dans la cellule de ligne 1 et de colonne 1
    xlSheet.Cells(1, 1) = "Quatrième Structure des donées"
    ExportFeuille xlSheet, rec
     '''''''''''''''''
    Set xlSheet = xlBook.Worksheets.Add
    xlSheet.Name = "Tutor4"
    Set rec = CurrentDb.OpenRecordset("pptéseau", dbOpenSnapshot)
    ' le titre4
    ' écriture dans la cellule de ligne 1 et de colonne 1
    xlSheet.Cells(1, 1) = "Cinquième Structure des donées"
    ExportFeuille xlSheet, rec
    '''''''''''''''''
    ''''''''''''''''''
 
    ' code de fermeture et libération des objets
    xlBook.SaveAs "C:\Users\utilisateur\Desktop\documents du stage\Monformulaire.xlsx"
    xlBook.Close False
    rec.Close
    Set rec = Nothing
    Set xlSheet = Nothing
    Set xlBook = Nothing
    xlApp.Quit
    Set xlApp = Nothing
    Debug.Print "Export complet en ", Format(Timer - t0, "0") & " secondes"
End Function

l'autre fonction est la suivante :

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
Private Sub ExportFeuille(xlSheet As Excel.Worksheet, rec As ADODB.Recordset)
Dim FieldPointer As Long
Dim RowPointer As Long
 
    'les entetes
    ' .Fields(Index).Name renvoie le nom du champ
    For FieldPointer = 0 To rec.Fields.Count - 1
        With xlSheet.Cells(3, FieldPointer + 1)
            .Value = rec.Fields(FieldPointer).Name
            ' Nous appliquons des enrichissements de format aux cellules
            .Interior.ColorIndex = 15
            .Interior.Pattern = xlSolid
            With .Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            .HorizontalAlignment = xlCenter
        End With
    Next FieldPointer
    ' recopie des données à partir de la ligne 3
    RowPointer = 4
    rec.MoveFirst
    Do While Not rec.EOF
        For FieldPointer = 0 To rec.Fields.Count - 1
            ' .Fields(Index).Type renvoie le type du champ
            ' si c'est un Texte (dbText) nous insérons "'" pour
            ' qu'il soit reconnu par Excel comme du Texte
            If rec.Fields(FieldPointer).Type = dbText Then
                xlSheet.Cells(RowPointer, FieldPointer + 1) = "'" & rec.Fields(FieldPointer)
            Else
                xlSheet.Cells(RowPointer, FieldPointer + 1) = rec.Fields(FieldPointer)
            End If
        Next FieldPointer
        RowPointer = RowPointer + 1
        rec.MoveNext
    Loop
 
 
End Sub

cordialement

**micniv** · 13/06/2016, 09h57

Bonjour,

je vois déjà : rec est déclaré DAO.recordset dans TransfertExcelAutomation1
et ADODB.Recordset dans ExportFeuille

aligner les déclarations
cordialement