Discussion :

[petitours]

Bonjour

Je crée un fichier Excel depuis Access en suivant cette logique

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
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
 
While Not oRst.EOF 'Pour chaque groupe de donnée
	Set xlSheet = xlBook.Worksheets.Add
	xlSheet.Name = oRst.Fields(0).Value
 
	Remplissage des cellules de la feuille...
	Mise en forme des cellules de la feuille...
	Tracé d'un graph basé sur 2 lignes de la feuille...
 
        Set xlSheet = Nothing
        oRst.MoveNext 
Wend
 
 
xlBook.SaveAs "C:\toto.xlsx"
xlApp.Quit
 
Set xlBook = Nothing
Set xlApp = Nothing

Je crée ainsi un fichier avec 8 feuilles de données ayant chacune un graphique.

Mon soucis est que quand j'ouvre le fichier excel j'ai
-Soit 2 fichiers qui s'ouvrent, l'un du nom de toto.xlsx avec mes 8 feuilles et les bonnes données dedans mais SANS graphique. L'autre du nom de classeurX (X est un numéro) avec dedans seulement la première feuille avec ses données mais 8 fois le graph qui s'ouvre sur cette feuille.
-Soit Seulement le premier de ces deux fichier ; celui du bon nom avec les bonnes données mais sans les graphs

Une idée de ce qui se passe ?

Merci par avance

[tee_grandbois]

Bonjour,
et pourquoi pas mettre le code complet ? Cela peut aider à trouver ce qui cloche...

[petitours]

Bonjour

Désolé de ne pas avoir donné réponse plus rapidement, j'ai eu des pépins tout autres que informatiques....

Bref, voici le code complet :

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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
Private Sub BtExportExcel1_Click()
On Error GoTo Err_BtExportExcel1_Click
 
    Dim stDocName As String
    Dim strSQL As String
    Dim ListeEnTeteDate As String
    Dim oRstEntete As DAO.Recordset
    Dim oRstComptes As DAO.Recordset
    Dim oRst As DAO.Recordset
 
    Dim xlApp As Excel.Application 'pour l'export sur EXCEL
    Dim xlSheet As Excel.Worksheet 'pour l'export sur EXCEL
    Dim xlBook As Excel.Workbook   'pour l'export sur EXCEL
    Dim I As Long, J As Long
    Dim y As Long
    Dim TotalPositif(100) As Double
    Dim TotalNegatif(100) As Double
    Dim TotalGeneral(100) As Double
    Dim Solde(100) As Double
    Dim valeur  As Double
    Dim Ladate As String
 
    Dim odb As DAO.Database
 
    Set odb = CurrentDb
    'Création de la liste des en tete de colonne (date par mois)
    strSQL = "SELECT * FROM [EXPORT1-ToutesLesDates] ORDER BY DateEnTete"
    Set oRstEntete = odb.OpenRecordset(strSQL)
 
    ListeEnTeteDate = ""
    While Not oRstEntete.EOF
        ListeEnTeteDate = ListeEnTeteDate & "'" & oRstEntete.Fields("DateEnTete").Value & "',"
        oRstEntete.MoveNext 'Passe à l'enregistrement suivant
    Wend
   ListeEnTeteDate = Left(ListeEnTeteDate, Len(ListeEnTeteDate) - 1)
  ' MsgBox ListeEnTeteDate
 
    'Mise à jour de la requète croisée sur laquelle se base l'export avec le groupement (les entetes demandées)
    stDocName = "EXPORT1-AnalyseCroisee"
    strSQL = "TRANSFORM Sum(Mouvements.[MontantTTC]) AS SommeDeMontantTTC "
    strSQL = strSQL & " SELECT Mouvements.[Compte], Mouvements.[CentreBudgetaire]"
    strSQL = strSQL & " FROM Mouvements"
    strSQL = strSQL & " GROUP BY Mouvements.[Compte], Mouvements.[CentreBudgetaire]"
    strSQL = strSQL & " PIVOT Format$([Mouvements].[DateMouvement],'yyyy mm') In (" & ListeEnTeteDate & ")"
    CurrentDb.QueryDefs(stDocName).SQL = strSQL  'mise à jour de la requète d'analyse croisée
 
 '   DoCmd.OpenQuery stDocName, acNormal, acEdit   'afffichage de la requete d'analyse croisée
 
'Initialisations pour export EXCEL
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
 
'Recherche de tous les comptes à traiter
    strSQL = ""
    strSQL = "SELECT DISTINCT [EXPORT1-AnalyseCroisee].Compte, Comptes.NomCompte "
    strSQL = strSQL & " FROM Comptes INNER JOIN [EXPORT1-AnalyseCroisee] ON Comptes.IDcompte = [EXPORT1-AnalyseCroisee].Compte"
    Set oRstComptes = odb.OpenRecordset(strSQL)
 
    ListeEnTeteDate = ""
    While Not oRstComptes.EOF 'Pour chaque compte
        ListeEnTeteDate = ListeEnTeteDate & "'" & oRstComptes.Fields("NomCompte").Value & "',"
 
    'Ajouter une feuille de calcul
        Set xlSheet = xlBook.Worksheets.Add
        xlSheet.Name = oRstComptes.Fields("NomCompte").Value
 
    'le titre
        '  écriture dans la cellule de ligne 1 et de colonne 1
        xlSheet.Cells(1, 1) = "Analyse du compte : " & oRstComptes.Fields("NomCompte").Value
 
    ' les entetes
        J = 2
        oRstEntete.MoveFirst
        While Not oRstEntete.EOF
            xlSheet.Cells(2, J) = oRstEntete.Fields("DateEnTete").Value
            ' Nous appliquons des enrichissements de format aux cellules
            With xlSheet.Cells(2, J)
                .Interior.ColorIndex = 15
                .Interior.Pattern = xlSolid
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
                .Borders(xlEdgeBottom).Weight = xlThin
                .Borders(xlEdgeBottom).ColorIndex = xlAutomatic
                .HorizontalAlignment = xlCenter
            End With
            J = J + 1
            oRstEntete.MoveNext 'Passe à l'enregistrement suivant
        Wend
 
        For y = 0 To 100
            TotalPositif(y) = 0
            TotalNegatif(y) = 0
            TotalGeneral(y) = 0
            Solde(y) = 0
        Next y
 
    'On charge un recordset avec les données du compte courant
        strSQL = ""
        strSQL = "SELECT DISTINCT [EXPORT1-AnalyseCroisee].*, [EXPORT1-AnalyseCroisee].Compte, CentreBudgetaire.NomCentreBudgetaire "
        strSQL = strSQL & " FROM CentreBudgetaire INNER JOIN [EXPORT1-AnalyseCroisee] ON CentreBudgetaire.IDcentreBudgetaire = [EXPORT1-AnalyseCroisee].CentreBudgetaire "
        strSQL = strSQL & " WHERE ((([EXPORT1-AnalyseCroisee].Compte)=" & oRstComptes.Fields("Compte").Value & "))"
        strSQL = strSQL & " ORDER BY CentreBudgetaire.NomCentreBudgetaire "
        Set oRst = odb.OpenRecordset(strSQL)
 
   ' recopie des données à partir de la ligne 7
        I = 7
        While Not oRst.EOF  'pour chaque centre budgetaire
            xlSheet.Cells(I, 1) = oRst.Fields("NomCentreBudgetaire").Value
            J = 2
            oRstEntete.MoveFirst
            While Not oRstEntete.EOF
                If IsNull(oRst.Fields(oRstEntete.Fields("DateEnTete").Value).Value) Then
                    'si c'est null on ne fait rien
                Else
                    valeur = oRst.Fields(oRstEntete.Fields("DateEnTete").Value).Value
                    xlSheet.Cells(I, J) = valeur
                    If (valeur > 0) Then
                        TotalPositif(J) = TotalPositif(J) + valeur
                    Else
                        TotalNegatif(J) = TotalNegatif(J) + valeur
                    End If
                End If
 
                J = J + 1
                oRstEntete.MoveNext 'Passe à l'enregistrement suivant
            Wend
 
            I = I + 1
            oRst.MoveNext
        Wend
 
   ' Enregistrement des 4 totaux
        J = 2
        oRstEntete.MoveFirst
        While Not oRstEntete.EOF
            xlSheet.Cells(6, J) = TotalNegatif(J)
            xlSheet.Cells(5, J) = TotalPositif(J)
            xlSheet.Cells(4, J) = TotalPositif(J) + TotalNegatif(J)
            Solde(J) = Solde(J - 1) + TotalPositif(J) + TotalNegatif(J)
            xlSheet.Cells(3, J) = Solde(J)
 
            J = J + 1
            oRstEntete.MoveNext 'Passe à l'enregistrement suivant
        Wend
 
    'Les nom de lignes de totaux
        xlSheet.Cells(3, 1) = "Solde fin de mois"
            With xlSheet.Rows(3)
                .Font.Color = RGB(255, 0, 0)
                .Font.Italic = True
                .HorizontalAlignment = xlRight
            End With
        xlSheet.Cells(4, 1) = "Total"
            With xlSheet.Rows(4)
                .Font.Color = RGB(255, 153, 0)
                .Font.Italic = True
                .HorizontalAlignment = xlRight
            End With
        xlSheet.Cells(5, 1) = "Total Recettes"
            With xlSheet.Rows(5)
                .Font.Color = RGB(51, 51, 255)
                .Font.Italic = True
                .HorizontalAlignment = xlRight
            End With
        xlSheet.Cells(6, 1) = "Total Dépenses"
            With xlSheet.Rows(6)
                .Font.Color = RGB(204, 51, 204)
                .Font.Italic = True
                .HorizontalAlignment = xlRight
            End With
 
    'Larguer colonne 1
            xlSheet.Columns(1).AutoFit
 
    'On fait un graphique du solde
            Rows("2:3").Select
            ActiveSheet.Shapes.AddChart.Select
 
            ActiveChart.ChartType = xlLineMarkers
            ActiveChart.Legend.Select
            Selection.Delete
 
   '         ActiveChart.SeriesCollection(1).ApplyDataLabels
 
        Set xlSheet = Nothing
        oRstComptes.MoveNext 'Passe au compte suivant
    Wend
 
 
 
' code de fermeture et libération des objets
 
    Ladate = "Prev" & Format(Date, "yyyy-mm-dd")
'MsgBox Ladate
    xlBook.SaveAs "C:\0-GESTION\" & Ladate & ".xlsx"
    xlApp.Quit
 
'Libération mémoire
    Set xlBook = Nothing
    Set xlApp = Nothing
 
    oRstEntete.Close: Set oRstEntete = Nothing      'Ferme le recordset
    oRstComptes.Close: Set oRstComptes = Nothing    'Ferme le recordset
    oRst.Close: Set oRst = Nothing                  'Ferme le recordset
 
    MsgBox ("Export terminé")
 
Exit_BtExportExcel1_Click:
    Exit Sub
 
Err_BtExportExcel1_Click:
    MsgBox Err.Description
    Resume Exit_BtExportExcel1_Click
 
End Sub

j'ai repassé la journée dessus, j'ai toujours des trucs étranges, de temps en temps ce que je veux, et quelquefois ca fait carrément planter VBA.

Merci par avance pour votre aide