Extraction sur Excel

**magictom42** · 05/06/2007, 11h22

Bonjour, j'ai réaliser une base de données sur Access.

Je dois faire un formulaire qui extrait les données d'une requete Access sur Excel suivant le jour que l'on selectionne dans une zone de liste, c'est-a-dire que cela extrait que les données du jour selectionnné.

Or quand je selectionne mon jour, et que je veux extraire, aucune donnée apparait dans le fichier Excel a part le nom des colonnes.

Voici mon code :

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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
 
Dim xlApp As Excel.Application
    Dim xlSheet As Excel.Worksheet
    Dim xlBook As Excel.Workbook
    Dim I As Long, J As Long
    Dim t0 As Long, t1 As Long
 
    t0 = Timer
    Dim rec As Recordset
    Dim sql As String
    sql = "SELECT Saisie.date, Saisie.machine, Saisie.causes, Saisie.heuredebut, Saisie.heurefin, [heurefin]-[heuredebut]*1 AS duree FROM Saisie WHERE Saisie.date=" & liste1.Value & " order by 2 desc;"
 
    Set rec = CurrentDb.OpenRecordset(sql, dbOpenSnapshot)
 
    'Initialisations
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
   xlApp.Visible = True
    'Ajouter une feuille de calcul
    Set xlSheet = xlBook.Worksheets.Add
    xlSheet.Name = "Pannes"
 
 
 
 
    ' le titre
    '  écriture dans la cellule de ligne 1 et de colonne 1
    xlSheet.Cells(1, 3) = "Liste des pannes"
 
     With xlSheet.Cells(1, 3)
            .Font.Size = 16
            .Font.Name = "Times New Roman"
 
 
    End With
 
    ' les entetes
    ' .Fields(Index).Name renvoie le nom du champ
    For J = 0 To rec.Fields.Count - 1
       xlSheet.Cells(3, J + 1) = rec.Fields(J).Name
 
 
      xlSheet.Columns.ColumnWidth = 15
 
        ' Nous appliquons des enrichissements de format aux cellules
        With xlSheet.Cells(3, J + 1)
            .Font.Size = 12
            .Font.Name = "Times New Roman"
            .Font.Bold = True
            .Interior.ColorIndex = 15
            .Interior.Pattern = xlSolid
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).Weight = xlThin
            .Borders(xlEdgeBottom).ColorIndex = xlAutomatic
            .HorizontalAlignment = xlCenter
 
 
        End With
 
    Next J
 
    ' recopie des données à partir de la ligne 3
    I = 4
    Do While Not rec.EOF
        For J = 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
            xlSheet.Cells(I, 1).NumberFormat = "DD/MM/YYYY"
            xlSheet.Cells(I, 4).NumberFormat = "hh:mm:ss"
            xlSheet.Cells(I, 5).NumberFormat = "hh:mm:ss"
            xlSheet.Cells(I, 6).NumberFormat = "hh:mm:ss"
 
            If rec.Fields(J).Type = dbText Then
                xlSheet.Cells(I, J + 1) = "'" & rec.Fields(J)
            Else
                xlSheet.Cells(I, J + 1) = rec.Fields(J)
            End If
 
           With xlSheet.Cells(I, J + 1)
           .HorizontalAlignment = xlCenter
           End With
 
 
        Next J
 
 
 
        I = I + 1
 
 
        rec.MoveNext
 
 
 
    Loop
 
 
 
    ' code de fermeture et libération des objets
    xlBook.SaveAs "\\Srvgpao\Bureautique\dossiers de partage SEAC\MAINTENANCE\Depannage\Pannes.xls"
    rec.Close
    Set rec = Nothing
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing