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 |
