Access Copie 2 fois la même colonne dans un fichier Excel

**rch05** · 15/11/2010, 09h24

Bonjour,

Je vais essayer d'expliquer mon pb.
J'ai un module qui créer un fichier Excel, et qui copie les données d'une table vers ce fichier Excel.
Dans le fichier Excel, j'ai un doublon de colonne, que je ne comprends pas.
La table contient 10 champs
Voir doc ci-joint.
Ci-dessous le code du module

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
107
108
109
110
111
112
113
114
115
116
117
118
119
120
 
 
Public Sub CreateExcelChart()
 
    Dim rst As ADODB.Recordset
    ' Variables objet Excel
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim xlChart As Excel.Chart
 
    Dim i As Integer, j As Integer, k As Integer
 
    On Error GoTo HandleErr
 
    ' Créé un objet Application Excel
    Set xlApp = New Excel.Application
 
    ' Créé un nouveau cahier d'exercices
    Set xlBook = xlApp.Workbooks.Add
 
    ' Se débarasse de tout excepté une feuille de travail
    xlApp.DisplayAlerts = False
    For i = xlBook.Worksheets.Count To 2 Step -1
        xlBook.Worksheets(i).Delete
    Next i
    xlApp.DisplayAlerts = True
 
    ' Récupère la référence vers la première feuille de travail
    Set xlSheet = xlBook.ActiveSheet
 
    ' Modifie le nom de la feuille de travail
    xlSheet.Name = conSheetName
 
    ' Créé un recordset
    Set rst = New ADODB.Recordset
    'Set rst = qryADV.OpenRecordset
    rst.Open _
     Source:=conQuery, _
     ActiveConnection:=CurrentProject.Connection
 
    'Le titre. Ecriture dans la cellule de ligne 1 et colonne 1
    xlSheet.Cells(1, 1) = "Nouvelle date de fin de fabrication"
        With xlSheet.Cells(1, 1)
            .Font.Bold = True
            .Font.Color = RGB(0, 0, 255)
            .Font.Size = 16
        End With
 
    'Les entetes sur la ligne 2
    For j = 0 To rst.fields.Count - 1
        xlSheet.Cells(2, j + 1) = rst.fields(j).Name
        'xlSheet.Cells(2, j + 1) = "ADV"
        ' Copie les noms de champs vers Excel
        ' Met en gras les en-têtes de colonne
        With xlSheet.Cells(2, j + 1)
            .Font.Bold = True
        End With
        'Mets en rouge le texte de la colonne 8
        With xlSheet.Cells(2, 8)
            .Font.Color = RGB(255, 0, 0)
        End With
    Next j
 
    ' Recopie les données à partir de la ligne 3
    i = 3
    Do While Not rst.EOF
        For j = 0 To rst.fields.Count - 1
 
            'si c'est du texte (dbText) on insére "'" pour qu'il soit
            'reconnu par EXCEL comme texte
            If rst.fields(j).Type = dbText Then
                xlSheet.Cells(i, j + 1) = "'" & rst.fields(j).Value
                'Mets en rouge le texte de la colonne 8
                With xlSheet.Cells(i, 8)
                    .Font.Color = RGB(255, 0, 0)
                End With
            Else
                'si c'est une date (dbDate) "jj/mm/aaaa" pour qu'il soit
                'reconnu par EXCEL comme une date
                If rst.fields(j).Type = dbDate Then
                    xlSheet.Cells(i, j + 1).NumberFormat = "jj/mm/aaaa"
                    xlSheet.Cells(i, j + 1) = rst.fields(j).Value
                    'Mets en rouge le texte de la colonne 8
                    With xlSheet.Cells(i, 8)
                        .Font.Color = RGB(255, 0, 0)
                    End With
                Else
                    xlSheet.Cells(i, j + 1) = rst.fields(j).Value
                    'Mets en rouge le texte de la colonne 8
                    With xlSheet.Cells(i, 8)
                        .Font.Color = RGB(255, 0, 0)
                    End With
                End If
            End If
        Next j
        i = i + 1
        rst.MoveNext
    Loop
 
 
    'Affiche le tableau Excel
    xlApp.Visible = True
 
ExitHere:
    On Error Resume Next
    ' Nettoyage des variables en mémoire
    xlBook.SaveAs "Planificateur.xls"
    rst.Close
    Set rst = Nothing
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
    Exit Sub
 
HandleErr:
    MsgBox Err & ": " & Err.Description, , "Erreur dans CreateExcelChart"
    Resume ExitHere
    Resume
End Sub