User

Objectif

Mettre à jour, avec une macro, les quantités en stock des articles, en fonction des mouvements d'entrée/sortie qui ont lieu au cours du temps.

I - Feuilles du classeur

On dispose pour cela de 4 feuilles pour enregistrer les données dans notre classeur :

1. Articles
2. Inventaire
3. Mouvements
4. Parametres

I.1 - Feuille Articles

Pour enregistrer les articles et visualiser leur quantité en stock.




I.2 - Feuille Inventaire

Pour enregistrer les quantités d'articles à une date donnée.



I.3 - Feuille Mouvements

Pour enregistrer les quantités d'articles entrées et sorties à une date précise.



I.4 - Feuille Parametres

Permet de définir pour chaque feuille, les indices minimums des colonnes et des lignes, mais aussi les noms des en-têtes des colonnes ("Réf. Article", "Qté Stock", etc..).

Par exemple, pour un indice de colonne minimum égal à B, et un indice de ligne minimum de 3, cela signifie que les données de la feuille commence sur la colonne B et la ligne 3, soir dans la cellule B3.



II - Modules VBA

Le classeur prend en charge les macros.

II.1 - Module M_GestionStock

Il permet d'actualiser les quantités en stock :

Code vba :

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
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
 
Option Explicit
 
' Paramètres pour les colonnes des feuilles
 
Dim IndLigneMin1 As Long
Dim IndLigneMin2 As Long
Dim IndLigneMin3 As Long
 
Dim IndColonneMin1 As Long
Dim IndColonneMin2 As Long
Dim IndColonneMin3 As Long
 
Dim IndColonneRefArticle1 As Long
Dim IndColonneRefArticle2 As Long
Dim IndColonneRefArticle3 As Long
 
Dim IndColonneQteStock1 As Long
Dim IndColonneQteStock3 As Long
 
Dim IndColonneDateInv2 As Long
 
Dim IndColonneQteInv2 As Long
Dim IndColonneQteInv3 As Long
 
Dim IndColonneDateMouv3 As Long
Dim IndColonneQteEntree3 As Long
Dim IndColonneQteSortie3 As Long
 
'***************************************************************
'***********   Renvoie la qté du dernier inventaire  ***********
'***************************************************************
Public Function QteDernierInventaire(RefArticle As String, dtMouv As Date) As Long
    Dim i As Long, dt As Date, qt As Long
    Dim c As Range, firstAddress As Variant
 
    If RefArticle = "" Or IsNull(dtMouv) Then
        QteDernierInventaire = 0
        Exit Function
    End If
 
    With Inventaire
 
        Set c = .Columns(IndColonneRefArticle2).Find(What:=RefArticle, After:=.Columns(IndColonneRefArticle2).Cells(.Columns(IndColonneRefArticle2).Cells.Count), LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
 
        If Not c Is Nothing Then
 
            firstAddress = c.Address
 
            Do
 
                i = c.Row
 
                If (CDate(.Cells(i, IndColonneDateInv2)) <= dtMouv) And (CDate(.Cells(i, IndColonneDateInv2)) > dt) Then
                   dt = CDate(.Cells(i, IndColonneDateInv2))
                   qt = .Cells(i, IndColonneQteInv2)
                End If
 
                Set c = .Columns(IndColonneRefArticle2).FindNext(c)
 
                If c Is Nothing Then Exit Do
 
            Loop While c.Address <> firstAddress
 
        End If
 
    End With
 
    QteDernierInventaire = qt
 
End Function
 
'****************************************************************
'***********   Renvoie la date du dernier inventaire  ***********
'****************************************************************
Public Function DtDernierInventaire(RefArticle As String, dtMouv As Date) As Long
    Dim i As Long, dt As Date, qt As Long
    Dim c As Range, firstAddress As Variant
 
    If RefArticle = "" Or IsNull(dtMouv) Then
       DtDernierInventaire = 0
       Exit Function
    End If
 
    With Inventaire
 
        Set c = .Columns(IndColonneRefArticle2).Find(What:=RefArticle, After:=.Columns(IndColonneRefArticle2).Cells(.Columns(IndColonneRefArticle2).Cells.Count), LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
 
        If Not c Is Nothing Then
 
            firstAddress = c.Address
 
            Do
 
                i = c.Row
 
                If (CDate(.Cells(i, IndColonneDateInv2)) <= dtMouv) And (CDate(.Cells(i, IndColonneDateInv2)) > dt) Then
                    dt = CDate(.Cells(i, IndColonneDateInv2))
                    qt = .Cells(i, IndColonneQteInv2)
                End If
 
                Set c = .Columns(IndColonneRefArticle2).FindNext(c)
 
                If c Is Nothing Then Exit Do
 
            Loop While c.Address <> firstAddress
 
        End If
 
    End With
 
    DtDernierInventaire = dt
 
End Function
 
'************************************************************************************
'***********  Renvoie la qté en stock pour 1 mouvement à une date précise ***********
'************************************************************************************
Public Function QteMouv(RefArticle As String, dtMouv As Date, indLigne As Long) As Long
    Dim i As Long, dt As Date, qt As Long
    Dim c As Range, firstAddress As Variant
 
    If RefArticle = "" Or IsNull(dtMouv) Then
        QteMouv = 0
        Exit Function
    End If
 
    dt = DtDernierInventaire(RefArticle, dtMouv)
    qt = 0
 
    With Mouvements
 
        Set c = .Columns(IndColonneRefArticle3).Find(What:=RefArticle, After:=.Columns(IndColonneRefArticle3).Cells(.Columns(IndColonneRefArticle3).Cells.Count), LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
 
        If Not c Is Nothing Then
 
            firstAddress = c.Address
 
            Do
 
                i = c.Row
 
                If (CDate(.Cells(i, IndColonneDateMouv3)) >= dt) And (dtMouv >= CDate(.Cells(i, IndColonneDateMouv3))) And (i <= indLigne) Then
                    If (.Cells(i, IndColonneQteEntree3).Value <> "") Then
                        qt = qt + CLng(.Cells(i, IndColonneQteEntree3))
                    ElseIf (.Cells(i, IndColonneQteSortie3).Value <> "") Then
                        qt = qt - CLng(.Cells(i, IndColonneQteSortie3))
                    End If
                End If
 
                Set c = .Columns(IndColonneRefArticle3).FindNext(c)
 
                If c Is Nothing Then Exit Do
 
           Loop While c.Address <> firstAddress
 
        End If
 
    End With
 
    QteMouv = qt
 
End Function
 
'*************************************************************************************
'***********  Actualise les quantités initiales et en cours par mouvement  ***********
'*************************************************************************************
Public Sub ActualiserQtesMouvs()
    Dim i As Long, RefArticle As String, dt As Date
    Dim qteInv As Long, qteStock As Long
 
    i = IndLigneMin3
 
    With Mouvements
 
        Do While .Cells(i, IndColonneRefArticle3).Value <> ""
 
            If .Cells(i, IndColonneDateMouv3).Value <> "" Then
 
                RefArticle = .Cells(i, IndColonneRefArticle3).Value
                dt = CDate(.Cells(i, IndColonneDateMouv3).Value)
 
                qteInv = QteDernierInventaire(RefArticle, dt)
                qteStock = QteMouv(RefArticle, dt, i)
 
                .Cells(i, IndColonneQteInv3).Value = qteInv
                .Cells(i, IndColonneQteStock3).Value = qteInv + qteStock
 
            End If
 
            i = i + 1
 
        Loop
 
    End With
 
End Sub
 
'**********************************************************************
'***********  Actualise les quantités en stock par Article  ***********
'**********************************************************************
Public Sub ActualiserQtesArticles()
    Dim i As Long, RefArticle As String
    Dim qteInv As Long, qteStock As Long
    Dim indLigneMax As Long
 
    i = IndLigneMin1
    indLigneMax = Mouvements.Cells(Mouvements.Columns(IndColonneMin3).Cells.Count, IndColonneMin3).End(xlUp).Row
 
    With Articles
 
        Do While .Cells(i, IndColonneRefArticle1).Value <> ""
 
            RefArticle = .Cells(i, IndColonneRefArticle1).Value
 
            qteInv = QteDernierInventaire(RefArticle, Date)
            qteStock = QteMouv(RefArticle, Date, indLigneMax)
 
            .Cells(i, IndColonneQteStock1).Value = qteInv + qteStock
 
            i = i + 1
 
        Loop
 
    End With
 
End Sub
 
 
 
Public Sub InitParametres()
 
    With Parametres
 
        IndLigneMin1 = .Cells(2, 2).Value
        IndLigneMin2 = .Cells(3, 2).Value
        IndLigneMin3 = .Cells(4, 2).Value
 
        IndColonneMin1 = Col_Number(.Cells(2, 3).Value)
        IndColonneMin2 = Col_Number(.Cells(3, 3).Value)
        IndColonneMin3 = Col_Number(.Cells(4, 3).Value)
 
        IndColonneRefArticle1 = IndiceColonne(1, .Cells(2, 4).Value)
        IndColonneRefArticle2 = IndiceColonne(2, .Cells(3, 4).Value)
        IndColonneRefArticle3 = IndiceColonne(3, .Cells(4, 4).Value)
 
        IndColonneQteStock1 = IndiceColonne(1, .Cells(2, 5).Value)
        IndColonneQteStock3 = IndiceColonne(3, .Cells(4, 5).Value)
 
        IndColonneDateInv2 = IndiceColonne(2, .Cells(3, 6).Value)
 
        IndColonneQteInv2 = IndiceColonne(2, .Cells(3, 7).Value)
        IndColonneQteInv3 = IndiceColonne(3, .Cells(4, 7).Value)
 
        IndColonneDateMouv3 = IndiceColonne(3, .Cells(4, 8).Value)
        IndColonneQteEntree3 = IndiceColonne(3, .Cells(4, 9).Value)
        IndColonneQteSortie3 = IndiceColonne(3, .Cells(4, 10).Value)
 
    End With
 
End Sub
 
Function Col_Letter(lngCol As Long) As String
    Dim vArr
    vArr = Split(Cells(1, lngCol).Address(True, False), "$")
    Col_Letter = vArr(0)
End Function
 
Function Col_Number(ColumnLetter As String) As Long
    'Return Column Number
    Col_Number = Range(ColumnLetter & "1").Column
End Function
 
Public Sub TriMouv()
    Dim indLigneMin As Long, indLigneMax As Long
    Dim IndColonneMax As Long, ColonneMax As String, ColonneMin As String, ColonneDateMouv As String
 
    indLigneMin = IndLigneMin3
    indLigneMax = Mouvements.Cells(Mouvements.Columns(IndColonneMin3).Cells.Count, IndColonneMin3).End(xlUp).Row
 
    IndColonneMax = Mouvements.Cells(IndLigneMin3, Mouvements.Columns.Count).End(xlToLeft).Column
 
    ColonneMin = Col_Letter(IndColonneMin3)
 
    ColonneDateMouv = Col_Letter(IndColonneDateMouv3)
    ColonneMax = Col_Letter(IndColonneMax)
 
    Mouvements.Sort.SortFields.Clear
    Mouvements.Sort.SortFields.Add2 Key:=Mouvements.Range(ColonneDateMouv & indLigneMin & ":" & ColonneDateMouv & indLigneMax) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
 
    With Mouvements.Sort
        .SetRange Mouvements.Range(ColonneMin & (indLigneMin - 1) & ":" & ColonneMax & indLigneMax)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
End Sub
 
Public Function IndiceColonne(indFeuille As Long, nomColonne As String) As Long
    Dim j As Long, indLigneMin As Long, indColonneMin As Long, ws As Worksheet
 
    Select Case indFeuille
 
    Case 1
        indLigneMin = IndLigneMin1
        indColonneMin = IndColonneMin1
        Set ws = Articles
    Case 2
        indLigneMin = IndLigneMin2
        indColonneMin = IndColonneMin2
        Set ws = Inventaire
    Case 3
        indLigneMin = IndLigneMin3
        indColonneMin = IndColonneMin3
        Set ws = Mouvements
 
    End Select
 
    j = indColonneMin
 
    Do While ws.Cells(indLigneMin - 1, j).Value <> ""
 
        If ws.Cells(indLigneMin - 1, j).Value = nomColonne Then
            IndiceColonne = j
            Exit Function
        End If
 
        j = j + 1
 
    Loop
 
 
End Function
 
Public Sub refreshQteStock()
    On Error GoTo err_refreshQteStock
 
    InitParametres
 
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.EnableEvents = False
 
    TriMouv
 
    ActualiserQtesArticles
    ActualiserQtesMouvs
 
err_refreshQteStock:
 
    If Err.Number <> 0 Then
        MsgBox (Err.Description)
    End If
 
    On Error Resume Next
 
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    'Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
 
End Sub

II.2 - Module M_Ruban

Le fichier comprend également un module pour actualiser les données depuis le ruban :

Code vba :

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
Option Explicit
 
Public Const REF_WBK = "Analyse v1"
Public Const REF_WBK_EXT = "*.XLSM"
Public Const CTR_Version = "10 novembre 2014"
 
'***************************************************************************************
'***********  Actualise les quantités en stock par Article à partir du ruban ***********
'***************************************************************************************
Sub ActualiserQuantitesStock_OnAction(Control As IRibbonControl)
 
    Select Case Control.ID
 
    Case "ActualiserQuantitesStock"
        refreshQteStock
    End Select
 
End Sub

Ci-joint le fichier Excel.