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
215
216
217
218
| Sub graph_IK()
'===========================================================
'crée les graphiques d'évolution dans chaque rapport sales
'
'Crée une table temporaire des données pour les graphiques
'input:parameter - annéé en cours - année n-1
'
'output:rp_xxxx (sales)
'===========================================================
Set DicoIKArea = CreateObject("Scripting.Dictionary")
DicoIKArea.CompareMode = vbTextCompare
Application.ScreenUpdating = False
b = Sheets("parameter").Range("A6:B" & Sheets("parameter").[B16].End(xlUp).Row) ' tableau a(n,1) pour rapidité
For i = LBound(b) To UBound(b)
If b(i, 1) <> "" Then
DicoIKArea(b(i, 1)) = Array(b(i, 2), 0, 0)
End If
Next i
ttemp = Worksheets("parameter").Range("A80").End(xlToRight).Column - 2
nbrprod = Worksheets("parameter").Range("A80").End(xlDown).Row
For i = 1 To ttemp
kk = Sheets("parameter").Cells(80, i + 1)
temp = DicoIKArea(kk)
temp(1) = Sheets("parameter").Cells(nbrprod, i + 1)
temp(2) = Sheets("parameter").Cells(nbrprod - 1, i + 1)
DicoIKArea(kk) = temp
Next i
Set DicoAct2 = CreateObject("Scripting.Dictionary") ' dict IK - area - groupe - année - week : C.A. de la semaine par famille
DicoAct2.CompareMode = vbTextCompare
Set DicoNCA = CreateObject("Scripting.Dictionary")
DicoNCA.CompareMode = vbTextCompare
Set DicoCA = CreateObject("Scripting.Dictionary")
DicoCA.CompareMode = vbTextCompare
'créer un tableau pivot pour chaque année => pv-...
active_year = StrConv(Sheets("parameter").Range("B2"), 2)
prev_year = active_year - 1
firstyear = StrConv(Sheets("parameter").Range("B3"), 2)
nbryear = active_year - firstyear + 1
'===========================================================
'Crée les dictionnaires pour le CA - marge et NCA
'===========================================================
For i = Sheets("parameter").Range("B3") To Sheets("parameter").Range("B2")
currentyear = StrConv(i, 2)
Set a = Nothing
ttt = Sheets(currentyear).[a1].End(xlDown).Row
a = Sheets(currentyear).Range("a1:z" & ttt) ' tableau a(n,1)
b = 0
For j = LBound(a) + 1 To UBound(a)
If a(j, 1) <> "" And a(j, 20) <> "BKS PT" Then
tu = a(j, 20) & a(j, 18) & a(j, 21) & a(j, 25) & a(j, 22)
If a(j, 25) > active_year - 2 Then
If Not (DicoAct2.exists(tu)) Then
DicoAct2(tu) = a(j, 16)
Else
DicoAct2(tu) = DicoAct2(tu) + a(j, 16)
End If
End If
End If
Next j
Next i
Set a = Nothing
nbrarea = DicoIKArea.Count
'crée la table donnée graphique temporaire
If FeuilleExiste(ActiveWorkbook, "data_graph") Then
'SendKeys ("{ENTER}")
Application.DisplayAlerts = False
Sheets("data_graph").Delete
Application.DisplayAlerts = True
End If
Sheets.Add
ActiveSheet.Name = "data_graph"
Sheets("data_graph").Select
Cells(1, 1).Select
i = 0
For Each area In DicoIKArea.keys
If area <> "Asean" And area <> "Interco" And area <> "Div" And area <> "NL1" And area <> "NL2" And area <> "FR" And area <> "LU" Then
Sheets("data_graph").Select
i = i + 1
posi = (i - 1) * 10 + 1
resp = DicoIKArea(area)(0)
' Worksheets("rp-" & resp).Select
budaf = DicoIKArea(area)(1)
budne = DicoIKArea(area)(2)
' Dim TabWeek(1 To 53) As Integer
' Dim budaf1(1 To 53), budneg1(1 To 53), Neg1(1 To 53), Neg2(1 To 53), Aff1(1 To 53), Aff2(1 To 53) As Double
Cells(posi, 1) = area
Cells(posi + 2, 1) = "Bud. Aff."
Cells(posi + 3, 1) = "Bud. Nég."
Cells(posi + 4, 1) = "Nég. " & active_year
Cells(posi + 5, 1) = "Nég. " & prev_year
Cells(posi + 6, 1) = "Aff. " & active_year
Cells(posi + 7, 1) = "Aff. " & prev_year
For j = 1 To 53
kkn = "BKS IK" & area & "Neg" & active_year & j
kkn1 = "BKS IK" & area & "Neg" & prev_year & j
kka = "BKS IK" & area & "Aff" & active_year & j
kka1 = "BKS IK" & area & "Aff" & prev_year & j
' TabWeek(j) = j
Cells(posi + 1, 1 + j) = j
If j = 1 Then
Cells(posi + 2, 1 + j) = budaf / 53 'budget affutage
Cells(posi + 3, 1 + j) = budne / 53 'budget négoce
Else
Cells(posi + 2, 1 + j) = Cells(posi + 2, 1 + j - 1) + budaf / 53 'budget affutage
Cells(posi + 3, 1 + j) = Cells(posi + 3, 1 + j - 1) + budne / 53 'budget négoce
End If
If DicoAct2.exists(kkn) Then
If j = 1 Then
Cells(posi + 4, 1 + j) = DicoAct2(kkn)
Else
Cells(posi + 4, 1 + j) = Cells(posi + 4, 1 + j - 1) + DicoAct2(kkn)
End If
Else
If j = 1 Then
Cells(posi + 4, 1 + j) = 0
Else
Cells(posi + 4, 1 + j) = Cells(posi + 4, 1 + j - 1)
End If
End If
If DicoAct2.exists(kkn1) Then
If j = 1 Then
Cells(posi + 5, 1 + j) = DicoAct2(kkn)
Else
Cells(posi + 5, 1 + j) = Cells(posi + 5, 1 + j - 1) + DicoAct2(kkn)
End If
Else
If j = 1 Then
Cells(posi + 5, 1 + j) = 0
Else
Cells(posi + 5, 1 + j) = Cells(posi + 5, 1 + j - 1)
End If
End If
If DicoAct2.exists(kka) Then
If j = 1 Then
Cells(posi + 6, 1 + j) = DicoAct2(kkn)
Else
Cells(posi + 6, 1 + j) = Cells(posi + 6, 1 + j - 1) + DicoAct2(kkn)
End If
Else
If j = 1 Then
Cells(posi + 6, 1 + j) = 0
Else
Cells(posi + 6, 1 + j) = Cells(posi + 6, 1 + j - 1)
End If
End If
If DicoAct2.exists(kka1) Then
If j = 1 Then
Cells(posi + 7, 1 + j) = DicoAct2(kkn)
Else
Cells(posi + 7, 1 + j) = Cells(posi + 7, 1 + j - 1) + DicoAct2(kkn)
End If
Else
If j = 1 Then
Cells(posi + 7, 1 + j) = 0
Else
Cells(posi + 7, 1 + j) = Cells(posi + 7, 1 + j - 1)
End If
End If
Next j
'===========================================================
'génération du graphique d'évolution dans chaque rapport sales
posi = Worksheets("rp-" & resp).Range("C3").End(xlDown).Row
Range(Cells((i - 1) * 10 + 2, 1), Cells((i - 1) * 10 + 8, 54)).Select
' Rows((i - 1) * 10 + 2 & ":" & (i - 1) * 10 + 8).Select
Sheets("rp-" & resp).Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlLine
ActiveChart.SetSourceData Source:=Range("data_graph!$" & (i - 1) * 10 + 2 & ":$" & (i - 1) * 10 + 8)
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = area
End With
ActiveChart.Location Where:=xlLocationAsObject, Name:="rp-" & resp
nbG = 0
For Each Graph In Sheets("rp-" & resp).ChartObjects
nbG = 1 + nbG
Next Graph
With ActiveSheet.Shapes(nbG)
.Width = 600
.Height = 350
.Left = Range("A" & (nbG - 1) * 30 + posi + 5).Left
.Top = Range("A" & (nbG - 1) * 30 + posi + 5).Top
End With
ActiveWorkbook.Save
End If
Next area
DicoAct2.RemoveAll
DicoIKArea.RemoveAll
Application.ScreenUpdating = True
End Sub |
