Microsoft 365 Fichier de stock automatisé

Tomasisco21

Tomasisco21

XLDnaute Nouveau
Bonjour à tous,

SVP j'aimerais savoir s'il est possible sur Excel, d'automatiser mon suivi de stock comme suit :

- Pour l'onglet "entrées" : toutes les saisies d'entrées doivent se mettre automatiquement sur l'onglet "suivi des stocks" conformément au modéle présenté.
- Pour l'onglet "sorties" : toutes les saisies de sorties doivent également se mettre de manière automatique sur l'onglet "suivi des stocks.
Par ailleurs, pour les sorties uniquement, le PU doit résulter automatiquement du PU moyen provenant de l'onglet "suivi des stocks".
- Pour l'onglet "suivi des stocks" aucune saisie à faire excepté une liste déroulante à insérer pour la partie "code et nature CAE".

D'avance merci pour votre aide, j'espère vraiment être un peu plus explicite dans ma demande.
 

Pièces jointes

  • Example File.xlsm
    135.4 KB · Affichages: 58
Solution
AtTheOne
Bonsoir à toutes & à tous, bonsoir @Ndenga Thomas
Je te joint un exemple de ce que j'ai pu faire.
  • Légère modification sur la macro de suppression de la dernière ligne :
    Si le tableau ne contient plus de ligne, le bouton affiche "Tableau vide !" et la macro ne s'exécute pas
    Enrichi (BBcode): 
    Sub Suppression()Dim txt$, shp As Shape
     On Error Resume Next
     txt = Application.Caller
     On Error GoTo 0
     If txt = "" Then Exit Sub
     Set shp = ActiveSheet.Shapes(txt)
     If shp.DrawingObject.Caption = "Supprimer dernière ligne" Then
          With ActiveSheet.ListObjects(1)
               .ListRows(.ListRows.Count).Delete
          End With
     Else
          MsgBox "Le tableau est déjà vidé !"
     End...
Trier par date Trier par votes
AtTheOne

AtTheOne

XLDnaute Impliqué
Supporter XLD
Bonsoir à toutes & à tous, bonsoir @Ndenga Thomas
Je te joint un exemple de ce que j'ai pu faire.
  • Légère modification sur la macro de suppression de la dernière ligne :
    Si le tableau ne contient plus de ligne, le bouton affiche "Tableau vide !" et la macro ne s'exécute pas
    Enrichi (BBcode): 
    Sub Suppression()Dim txt$, shp As Shape
     On Error Resume Next
     txt = Application.Caller
     On Error GoTo 0
     If txt = "" Then Exit Sub
     Set shp = ActiveSheet.Shapes(txt)
     If shp.DrawingObject.Caption = "Supprimer dernière ligne" Then
          With ActiveSheet.ListObjects(1)
               .ListRows(.ListRows.Count).Delete
          End With
     Else
          MsgBox "Le tableau est déjà vidé !"
     End If
End Sub

  • Macros appelées lors de l'activation de la feuille "Suivi des stocks" :
    Insère les lignes existant dans l'une des feuilles "Entrée", "Sortie" qui ne se retrouvent pas dans "Suivi des stocks"
    Enrichi (BBcode): 
    Sub Insérer_Nouveau(FS$)
     Dim Wsh_S As Worksheet, Wsh_C As Worksheet
     Dim Lo_S As ListObject, Lo_C As ListObject, tS, tC, Clef
     Dim i As Integer, ligne As Integer, j As Byte
     Dim Dc_Mvt As New Scripting.Dictionary
     Dim Dc_Stock As New Scripting.Dictionary
     Dc_Mvt.CompareMode = TextCompare
     Dc_Stock.CompareMode = TextCompare
     Dim tb1(1 To 1, 1 To 3), tb2(1 To 1, 1 To 3)
   
     Set Wsh_S = ThisWorkbook.Worksheets(FS)
     Set Wsh_C = ThisWorkbook.Worksheets("Suivi des stocks")
     Select Case FS
          Case "Entrée"
               tS = Wsh_S.[t_Entree]
          Case "Sortie"
               tS = Wsh_S.[t_Sortie]
          Case Else
               Exit Sub
     End Select
     For i = 1 To UBound(tS)
          Dc_Mvt(tS(i, 2)) = i
     Next i
     tC = Wsh_C.[t_Stock]
     For i = 1 To UBound(tC)
          Dc_Stock(tC(i, 2)) = i
     Next i
   
     On Error Resume Next
     Dc_Mvt.Remove ("")
     Dc_Stock.Remove ("")
     On Error GoTo 0
   
     If Dc_Mvt.Count = 0 Then Exit Sub
   
     Set Lo_S = Wsh_S.ListObjects(1)
     Set Lo_C = Wsh_C.ListObjects(1)
     Clef = Dc_Mvt.Keys
     For i = 1 To Dc_Mvt.Count
          If Not Dc_Stock.Exists(Clef(i - 1)) Then
               ligne = Dc_Mvt(Clef(i - 1))
               For j = 1 To 3
                    tb1(1, j) = tS(ligne, j)
               Next j
               tb2(1, 1) = tS(ligne, 9)
               tb2(1, 2) = tS(ligne, 10)
               tb2(1, 3) = FS
               With Lo_C
                    .ListRows.Add
                    .ListRows(.ListRows.Count).Range.Cells(1).Resize(1, 3).Value = tb1
                    .ListRows(.ListRows.Count).Range.Cells(10).Resize(1, 3).Value = tb2
               End With
          End If
     Next i
   
End Sub

    Evénement activate de la feuille "Suivi des stocks" :
    Appelle la macro précédante, et trie le tableau dans l'ordre chronologique
    Code: 
    Private Sub Worksheet_Activate()
     Application.ScreenUpdating = False
     Insérer_Nouveau "Entrée"
     Insérer_Nouveau "Sortie"
     With Me.ListObjects("t_Stock").Sort
          .SortFields.Clear
          .SortFields.Add Key:=Range("t_Stock[Date]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
          .SortFields.Add Key:=Range("t_Stock[N° Bon]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
          .Header = xlYes
          .MatchCase = False
          .Orientation = xlTopToBottom
          .Apply
     End With
     Application.ScreenUpdating = True
End Sub

  • Macro exécutée lors d'une modification de la feuille "Entrée"
    Enrichi (BBcode): 
    Private Sub Worksheet_Change(ByVal Target As Range)     If Intersect(Target, Me.[t_Entree]) Is Nothing Then Exit Sub
   
     Dim Dc As New Scripting.Dictionary
     Dim tS, tC, WshC As Worksheet, r As Range, t
     Dim tb1(1 To 1, 1 To 3), tb2(1 To 1, 1 To 3)
     Dim i%, ligne%
     Set WshC = Worksheets("Suivi des stocks")
     tS = Me.[t_Entree]
     tC = WshC.[t_Stock]
     For i = 1 To UBound(tC)
          Dc(tC(i, 2)) = i
     Next
     For Each r In Target.Rows
          t = Intersect(Me.[t_Entree], r.EntireRow)
          If Not IsEmpty(t(1, 2)) Then
               For i = 1 To 3
                    tb1(1, i) = t(1, i)
               Next i
               tb2(1, 1) = t(1, 9)
               tb2(1, 2) = t(1, 10)
               tb2(1, 3) = Me.Name
               If Dc.Exists(t(1, 2)) Then
                    ligne = Dc(t(1, 2))
               Else
                    With WshC.ListObjects("t_Stock")
                         .ListRows.Add
                         ligne = .ListRows.Count
                    End With
               End If
               With WshC.[t_Stock]
                    .Cells(ligne, 1).Resize(1, 3) = tb1
                    .Cells(ligne, 10).Resize(1, 3) = tb2
               End With
                   
             
          End If
     Next
End Sub

  • Macro exécutée lors d'une modification de la feuille "Sortie"
    Enrichi (BBcode): 
    Private Sub Worksheet_Change(ByVal Target As Range)
     If Intersect(Target, Me.[t_Sortie]) Is Nothing Then Exit Sub
   
     Dim Dc As New Scripting.Dictionary
     Dim tS, tC, WshC As Worksheet, r As Range, t
     Dim tb1(1 To 1, 1 To 3), tb2(1 To 1, 1 To 3)
     Dim i%, ligne%
     Set WshC = Worksheets("Suivi des stocks")
     tS = Me.[t_Sortie]
     tC = WshC.[t_Stock]
     For i = 1 To UBound(tC)
          Dc(tC(i, 2)) = i
     Next
     For Each r In Target.Rows
          t = Intersect(Me.[t_Sortie], r.EntireRow)
          If Not IsEmpty(t(1, 2)) Then
               For i = 1 To 3
                    tb1(1, i) = t(1, i)
               Next i
               tb2(1, 1) = t(1, 9)
               tb2(1, 2) = t(1, 10)
               tb2(1, 3) = Me.Name
               If Dc.Exists(t(1, 2)) Then
                    ligne = Dc(t(1, 2))
               Else
                    With WshC.ListObjects("t_Stock")
                         .ListRows.Add
                         ligne = .ListRows.Count
                    End With
               End If
               With WshC.[t_Stock]
                    .Cells(ligne, 1).Resize(1, 3) = tb1
                    .Cells(ligne, 10).Resize(1, 3) = tb2
               End With
                   
             
          End If
     Next
End Sub
En cas de modification sur l'une des deux feuilles "Entrée", "Sortie", la feuille "Suivi des stocks" est mise à jour immédiatement. Sauf en cas de suppression d'une ligne. Il peut y avoir des bugs si l'on change le N° de bon car c'est sur cette information que j'identifie les lignes impactées.
J'ai laissé telles quelles tes formules car je ne suis pas sûr des régles que tu appliques.
Voilà, bon courage

Amicalement
Alain
Tiens moi informé
Amicalement
Alain
 

Pièces jointes

  • Fichier de stock automatisé 1.xlsm
    95.7 KB · Affichages: 85
Vote positif 1 Vote négatif
Solution
Tomasisco21

Tomasisco21

XLDnaute Nouveau
AtTheOne à dit:
Bonsoir à toutes & à tous, bonsoir @Ndenga Thomas
Je te joint un exemple de ce que j'ai pu faire.
  • Légère modification sur la macro de suppression de la dernière ligne :
    Si le tableau ne contient plus de ligne, le bouton affiche "Tableau vide !" et la macro ne s'exécute pas
    Enrichi (BBcode): 
    Sub Suppression()Dim txt$, shp As Shape
     On Error Resume Next
     txt = Application.Caller
     On Error GoTo 0
     If txt = "" Then Exit Sub
     Set shp = ActiveSheet.Shapes(txt)
     If shp.DrawingObject.Caption = "Supprimer dernière ligne" Then
          With ActiveSheet.ListObjects(1)
               .ListRows(.ListRows.Count).Delete
          End With
     Else
          MsgBox "Le tableau est déjà vidé !"
     End If
End Sub

  • Macros appelées lors de l'activation de la feuille "Suivi des stocks" :
    Insère les lignes existant dans l'une des feuilles "Entrée", "Sortie" qui ne se retrouvent pas dans "Suivi des stocks"
    Enrichi (BBcode): 
    Sub Insérer_Nouveau(FS$)
     Dim Wsh_S As Worksheet, Wsh_C As Worksheet
     Dim Lo_S As ListObject, Lo_C As ListObject, tS, tC, Clef
     Dim i As Integer, ligne As Integer, j As Byte
     Dim Dc_Mvt As New Scripting.Dictionary
     Dim Dc_Stock As New Scripting.Dictionary
     Dc_Mvt.CompareMode = TextCompare
     Dc_Stock.CompareMode = TextCompare
     Dim tb1(1 To 1, 1 To 3), tb2(1 To 1, 1 To 3)
  
     Set Wsh_S = ThisWorkbook.Worksheets(FS)
     Set Wsh_C = ThisWorkbook.Worksheets("Suivi des stocks")
     Select Case FS
          Case "Entrée"
               tS = Wsh_S.[t_Entree]
          Case "Sortie"
               tS = Wsh_S.[t_Sortie]
          Case Else
               Exit Sub
     End Select
     For i = 1 To UBound(tS)
          Dc_Mvt(tS(i, 2)) = i
     Next i
     tC = Wsh_C.[t_Stock]
     For i = 1 To UBound(tC)
          Dc_Stock(tC(i, 2)) = i
     Next i
  
     On Error Resume Next
     Dc_Mvt.Remove ("")
     Dc_Stock.Remove ("")
     On Error GoTo 0
  
     If Dc_Mvt.Count = 0 Then Exit Sub
  
     Set Lo_S = Wsh_S.ListObjects(1)
     Set Lo_C = Wsh_C.ListObjects(1)
     Clef = Dc_Mvt.Keys
     For i = 1 To Dc_Mvt.Count
          If Not Dc_Stock.Exists(Clef(i - 1)) Then
               ligne = Dc_Mvt(Clef(i - 1))
               For j = 1 To 3
                    tb1(1, j) = tS(ligne, j)
               Next j
               tb2(1, 1) = tS(ligne, 9)
               tb2(1, 2) = tS(ligne, 10)
               tb2(1, 3) = FS
               With Lo_C
                    .ListRows.Add
                    .ListRows(.ListRows.Count).Range.Cells(1).Resize(1, 3).Value = tb1
                    .ListRows(.ListRows.Count).Range.Cells(10).Resize(1, 3).Value = tb2
               End With
          End If
     Next i
  
End Sub

    Evénement activate de la feuille "Suivi des stocks" :
    Appelle la macro précédante, et trie le tableau dans l'ordre chronologique
    Code: 
    Private Sub Worksheet_Activate()
     Application.ScreenUpdating = False
     Insérer_Nouveau "Entrée"
     Insérer_Nouveau "Sortie"
     With Me.ListObjects("t_Stock").Sort
          .SortFields.Clear
          .SortFields.Add Key:=Range("t_Stock[Date]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
          .SortFields.Add Key:=Range("t_Stock[N° Bon]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
          .Header = xlYes
          .MatchCase = False
          .Orientation = xlTopToBottom
          .Apply
     End With
     Application.ScreenUpdating = True
End Sub

  • Macro exécutée lors d'une modification de la feuille "Entrée"
    Enrichi (BBcode): 
    Private Sub Worksheet_Change(ByVal Target As Range)     If Intersect(Target, Me.[t_Entree]) Is Nothing Then Exit Sub
  
     Dim Dc As New Scripting.Dictionary
     Dim tS, tC, WshC As Worksheet, r As Range, t
     Dim tb1(1 To 1, 1 To 3), tb2(1 To 1, 1 To 3)
     Dim i%, ligne%
     Set WshC = Worksheets("Suivi des stocks")
     tS = Me.[t_Entree]
     tC = WshC.[t_Stock]
     For i = 1 To UBound(tC)
          Dc(tC(i, 2)) = i
     Next
     For Each r In Target.Rows
          t = Intersect(Me.[t_Entree], r.EntireRow)
          If Not IsEmpty(t(1, 2)) Then
               For i = 1 To 3
                    tb1(1, i) = t(1, i)
               Next i
               tb2(1, 1) = t(1, 9)
               tb2(1, 2) = t(1, 10)
               tb2(1, 3) = Me.Name
               If Dc.Exists(t(1, 2)) Then
                    ligne = Dc(t(1, 2))
               Else
                    With WshC.ListObjects("t_Stock")
                         .ListRows.Add
                         ligne = .ListRows.Count
                    End With
               End If
               With WshC.[t_Stock]
                    .Cells(ligne, 1).Resize(1, 3) = tb1
                    .Cells(ligne, 10).Resize(1, 3) = tb2
               End With
                  
            
          End If
     Next
End Sub

  • Macro exécutée lors d'une modification de la feuille "Sortie"
    Enrichi (BBcode): 
    Private Sub Worksheet_Change(ByVal Target As Range)
     If Intersect(Target, Me.[t_Sortie]) Is Nothing Then Exit Sub
  
     Dim Dc As New Scripting.Dictionary
     Dim tS, tC, WshC As Worksheet, r As Range, t
     Dim tb1(1 To 1, 1 To 3), tb2(1 To 1, 1 To 3)
     Dim i%, ligne%
     Set WshC = Worksheets("Suivi des stocks")
     tS = Me.[t_Sortie]
     tC = WshC.[t_Stock]
     For i = 1 To UBound(tC)
          Dc(tC(i, 2)) = i
     Next
     For Each r In Target.Rows
          t = Intersect(Me.[t_Sortie], r.EntireRow)
          If Not IsEmpty(t(1, 2)) Then
               For i = 1 To 3
                    tb1(1, i) = t(1, i)
               Next i
               tb2(1, 1) = t(1, 9)
               tb2(1, 2) = t(1, 10)
               tb2(1, 3) = Me.Name
               If Dc.Exists(t(1, 2)) Then
                    ligne = Dc(t(1, 2))
               Else
                    With WshC.ListObjects("t_Stock")
                         .ListRows.Add
                         ligne = .ListRows.Count
                    End With
               End If
               With WshC.[t_Stock]
                    .Cells(ligne, 1).Resize(1, 3) = tb1
                    .Cells(ligne, 10).Resize(1, 3) = tb2
               End With
                  
            
          End If
     Next
End Sub
En cas de modification sur l'une des deux feuilles "Entrée", "Sortie", la feuille "Suivi des stocks" est mise à jour immédiatement. Sauf en cas de suppression d'une ligne. Il peut y avoir des bugs si l'on change le N° de bon car c'est sur cette information que j'identifie les lignes impactées.
J'ai laissé telles quelles tes formules car je ne suis pas sûr des régles que tu appliques.
Voilà, bon courage

Amicalement
Alain
Tiens moi informé
Amicalement
Alain
Cliquez pour agrandir...
Bjr M. Alain,

Enorme 🙏👏 et GRAND MERCI : le problème est résolu. T'es un bon, les codes VBA fonctionnent correctement
 
Vote positif 0 Vote négatif

Discussions similaires

S
  • Question
Access Gestion de stock
Réponses
0
Affichages
367
Schwalby
S
P
  • Question
Microsoft 365 gestion de stock avec plusieurs date de production sur même produit
Réponses
12
Affichages
1 K
pouetpouetlagalette
P
Tomasisco21
  • Question
Microsoft 365 Fichier automatisé VBA - Template Budget project
Réponses
5
Affichages
519
Tomasisco21
Tomasisco21
S
  • Question
XL pour MAC Tableau de gestion de production et de stock
Réponses
14
Affichages
627
ScamPs
S
Tomasisco21
  • Résolu(e)
Microsoft 365 Code VBA pour rechercher la valeur d'un produit sur 02 tables matrices (ou 02 onglets)
Réponses
8
Affichages
721
goube
goube
N
  • Résolu(e)
XL 2016 tableau de vente/gestion des stocks boutique : quelles formules ?!
Réponses
12
Affichages
1 K
Gégé-45550
Gégé-45550
M
  • Question
Microsoft 365 Gestion de stock pharmacie (entrée, sortie, graphiques)
2 3 4
Réponses
47
Affichages
9 K
JM27
J
L
  • Question
XL 2016 Gestion de stock excel
Réponses
6
Affichages
2 K
Lily37
L
M
  • Question
Microsoft 365 Gestion d'une refacturation en fonction d'un inventaire
Réponses
1
Affichages
380
MUGMRG
M
D
  • Résolu(e)
XL 2019 Gestion de stock produits frais
Réponses
6
Affichages
1 K
Dadoo80
D

Membres actuellement en ligne

1 membres et 39 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 084
Messages
2 085 194
Membres
102 813
dernier inscrit
kaiyi