Microsoft 365 Mise à jour cellules du stock

rubis54

XLDnaute Occasionnel
Bonjour tout le monde,

Après multiples changements de mon classeur Stock, je pense avoir trouvé quelque chose de plus simple mais trop difficile pour moi en ce qui concerne le VBA pour faire fonctionner cela.

Explications:

A part la feuille "TDB" et "STOCK" il y a 3 feuilles supplémentaires "SORTIE DU JOUR, COMMANDE et ENTREE STOCK"

- sur ces trois feuilles, on se place sur B2 pour taper les premières lettres de l'article recherché et on presse la touche Entrée. Ensuite il affiche en colonne "D" les articles trouvés. On choisit ensuite l'article voulu, on double clique sur l'article et il vient s'afficher dans le tableau à droite(pareil pour les trois feuilles) il ne reste plus qu'a remplir les cellules de la colonne Qté.

Jusqu'ici tout va bien. Lorsque je clique sur "RAZ et Mise à jour stock", il mets à jour uniquement les deux premières lignes de mon stock. Donc même si je choisis un seul article par exemple " tomates " pour la sortie du jour , pour la commande ou pour entrée stock, il mettra à jour la première ligne de mon stock au lieu de mettre à jour la ligne des tomates dans le stock.

Alors est ce quelqu'un pourrai m'aider à rectifier ces erreurs SVP.

Je vous Remercie d'avance.

Rubis54
 

Pièces jointes

  • gestion-stock.xlsm
    234.6 KB · Affichages: 37

rubis54

XLDnaute Occasionnel
Je n'ai rien fourni pour la feuille stock .

Le worksheet_change au post 4 concerne uniquement la feuille "sortie du jour".
Bonjour Fanch55,

je suis vraiment désolé de vous embêter à ce point, mais j'ai du mal à comprendre .

Le code ci-dessous je l'ai placé dans la feuille "STOCK"
"Private Sub Worksheet_Activate()
If [Tableau2].ListObject.AutoFilter Is Nothing Then
[Tableau2].AutoFilter
End If
End Sub"
Est ce correct ?

Ensuite le code ci-dessous je l'ai placé dans la feuille "SORTIE DU JOUR"
Private Sub Worksheet_Change(ByVal Target As Range)

" If Target.Address = [B2].Address Then
Range("D2:D" & WorksheetFunction.Max(2, Cells(Rows.Count, "D").End(xlUp).Row)).Clear
[Tableau2].ListObject.Range.AutoFilter
[Tableau2].ListObject.Range.AutoFilter Field:=2, Criteria1:="=" & [B2] & "*", Operator:=xlAnd
[Tableau2].ListObject.Range.AutoFilter Field:=5, Criteria1:=">0", Operator:=xlAnd
[Tableau2[Désignation]].SpecialCells(xlCellTypeVisible).Copy [D2]
[Tableau2].ListObject.Range.AutoFilter
End If

End Sub"

Est ce correct?

Mais si je veux éxecuter ce code il m'ouvre la fenêtre des macros !

Voici tout ce qui a dans la feuille "SORTIE DU JOUR"

Private Sub Worksheet_Change(ByVal Target As Range)

' Macro1 Macro
'

'
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
Sheets("STOCK").Range("B1:B1685").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("SORTIE DU JOUR").Range _
("B1:B2"), CopyToRange:=Range("D1"), Unique:=False

End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim derniereligne As Integer

'affiche le numéro de la dernière ligne de la colonne F
derniereligne = Range("F" & Rows.Count).End(xlUp).Row

' Ne fonctionne que si les produits sont triés en colonne B
If Target.Count = 1 Then
If Not Intersect(Target, [D1:D1685]) Is Nothing Then

'trouver, en colonne B, la position de la 1re occurence du produit
ligneDépart = Application.Match(Target, [D1:D1685], 0)

'trouve la dernière ligne de la colonne F et décale cette ligne vers le bas grace au +1
Range("F" & derniereligne + 1).Value = Target

End If
End If
Cancel = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = [B2].Address Then
Range("D2:D" & WorksheetFunction.Max(2, Cells(Rows.Count, "D").End(xlUp).Row)).Clear
[Tableau2].ListObject.Range.AutoFilter
[Tableau2].ListObject.Range.AutoFilter Field:=2, Criteria1:="=" & [B2] & "*", Operator:=xlAnd
[Tableau2].ListObject.Range.AutoFilter Field:=5, Criteria1:=">0", Operator:=xlAnd
[Tableau2[Désignation]].SpecialCells(xlCellTypeVisible).Copy [D2]
[Tableau2].ListObject.Range.AutoFilter
End If

End Sub

Merci à vous pour votre réponse.
Cdt Rubis54
 

ChTi160

XLDnaute Barbatruc
Bonjour rubis54
Bonjour le Fil,le forum

Pas sûr d'avoir compris lol
Mais dans les éléments d'une feuille tu ne peux avoir qu'une seule procédure événementielle de chaque type.
Exemple une seule
Private Sub Worksheet_Change(ByVal Target As Range)
Il faut alors regrouper ce que tu veux faire lors de cet événement dans une seule procédure,ou de supprimer ce qui ne sert pas
Jean marie
 

rubis54

XLDnaute Occasionnel
Bonjour rubis54
Bonjour le Fil,le forum

Pas sûr d'avoir compris lol
Mais dans les éléments d'une feuille tu ne peux avoir qu'une seule procédure événementielle de chaque type.
Exemple une seule

Il faut alors regrouper ce que tu veux faire lors de cet événement dans une seule procédure,ou de supprimer ce qui ne sert pas
Jean marie
Bonjour ChTi160,
Merci pour ton info.
Alors comment je fais ? je supprime la procédure ci dessous, je vais la placer ou pour que le reste fonctionne ?
Merci d'avance pour ton aide
Cdt Rubis54

"Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim derniereligne As Integer

'affiche le numéro de la dernière ligne de la colonne F
derniereligne = Range("F" & Rows.Count).End(xlUp).Row

' Ne fonctionne que si les produits sont triés en colonne B
If Target.Count = 1 Then
If Not Intersect(Target, [D1:D1685]) Is Nothing Then

'trouver, en colonne B, la position de la 1re occurence du produit
ligneDépart = Application.Match(Target, [D1:D1685], 0)

'trouve la dernière ligne de la colonne F et décale cette ligne vers le bas grace au +1
Range("F" & derniereligne + 1).Value = Target

End If
End If
Cancel = True
End Sub"
 

rubis54

XLDnaute Occasionnel
Bonjour à tous,
Tu remplaces toute ta partie

par la mienne ( ou tu mets la tienne en commentaire )
Bonjour Fanch55

Donc j'ai fais comme ca ci-dessous

Private Sub Worksheet_Change(ByVal Target As Range)

' Macro1 Macro
'

'
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
Sheets("STOCK").Range("B1:B1685").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("SORTIE DU JOUR").Range _
("B1:B2"), CopyToRange:=Range("D1"), Unique:=False




Dim derniereligne As Integer

'affiche le numéro de la dernière ligne de la colonne F
derniereligne = Range("F" & Rows.Count).End(xlUp).Row

' Ne fonctionne que si les produits sont triés en colonne B
If Target.Count = 1 Then
If Not Intersect(Target, [D1:D1685]) Is Nothing Then

'trouver, en colonne B, la position de la 1re occurence du produit
ligneDépart = Application.Match(Target, [D1:D1685], 0)

'trouve la dernière ligne de la colonne F et décale cette ligne vers le bas grace au +1
Range("F" & derniereligne + 1).Value = Target

End If
End If
Cancel = True


If Target.Address = [B2].Address Then
Range("D2:D" & WorksheetFunction.Max(2, Cells(Rows.Count, "D").End(xlUp).Row)).Clear
[Tableau2].ListObject.Range.AutoFilter
[Tableau2].ListObject.Range.AutoFilter Field:=2, Criteria1:="=" & [B2] & "*", Operator:=xlAnd
[Tableau2].ListObject.Range.AutoFilter Field:=5, Criteria1:=">0", Operator:=xlAnd
[Tableau2[Désignation]].SpecialCells(xlCellTypeVisible).Copy [D2]
[Tableau2].ListObject.Range.AutoFilter
End If

End Sub

Mais si j'éxecute il m'ouvre la fenêtre des macros !!!
 

rubis54

XLDnaute Occasionnel
J'aurais pas dit mieux lol

Si tu en a besoin et qu'elle n'est pas en double tu la laisses
Supprime juste le double du

Jean marie
Re Jean-Marie,

alors j'ai placé le tout comme ci-dessous dans la feuille"SORTIE DU JOUR", mais il m'affiche toujours encore les articles qui n'ont pas de quantité stock, donc 0.


Private Sub Worksheet_Change(ByVal Target As Range)

' Macro1 Macro

Sheets("STOCK").Range("B1:B1685").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("SORTIE DU JOUR").Range _
("B1:B2"), CopyToRange:=Range("D1"), Unique:=False

If Target.Address = [B2].Address Then
Range("D2:D" & WorksheetFunction.Max(2, Cells(Rows.Count, "D").End(xlUp).Row)).Clear
[Tableau2].ListObject.Range.AutoFilter
[Tableau2].ListObject.Range.AutoFilter Field:=2, Criteria1:="=" & [B2] & "*", Operator:=xlAnd
[Tableau2].ListObject.Range.AutoFilter Field:=5, Criteria1:=">0", Operator:=xlAnd
[Tableau2[Désignation]].SpecialCells(xlCellTypeVisible).Copy [D2]
[Tableau2].ListObject.Range.AutoFilter
End If

End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim derniereligne As Integer

'affiche le numéro de la dernière ligne de la colonne F
derniereligne = Range("F" & Rows.Count).End(xlUp).Row

' Ne fonctionne que si les produits sont triés en colonne B
If Target.Count = 1 Then
If Not Intersect(Target, [D1:D1685]) Is Nothing Then

'trouver, en colonne B, la position de la 1re occurence du produit
ligneDépart = Application.Match(Target, [D1:D1685], 0)

'trouve la dernière ligne de la colonne F et décale cette ligne vers le bas grace au +1
Range("F" & derniereligne + 1).Value = Target

End If
End If
Cancel = True
End Sub
 

fanch55

XLDnaute Barbatruc
Tu vas remplacer tout le code de la feuille "Sortie du Jour" par celui-ci :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.Address = [B2].Address Then
        Range("D2:D" & WorksheetFunction.Max(2, Cells(Rows.Count, "D").End(xlUp).Row)).Clear
        [Tableau2].ListObject.Range.AutoFilter
        [Tableau2].ListObject.Range.AutoFilter Field:=2, Criteria1:="=" & [B2] & "*", Operator:=xlAnd
        [Tableau2].ListObject.Range.AutoFilter Field:=5, Criteria1:=">0", Operator:=xlAnd
        [Tableau2[Désignation]].SpecialCells(xlCellTypeVisible).Copy [D2]
        [Tableau2].ListObject.Range.AutoFilter
    End If
    
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim Ligne As Integer:
    
    If Target.Count = 1 Then
        Ligne = Range("D" & Rows.Count).End(xlUp).Row
        If Not Intersect(Target, Range("D1:D" & Ligne)) Is Nothing Then
            Ligne = Range("F" & Rows.Count).End(xlUp).Row
            Range("F" & Ligne + 1).Value = Target
            Range("G" & Ligne + 1).Activate
        End If
    End If
    Cancel = True
    
End Sub

Et n'essayes pas de les exécuter, ce sont des macros événementielles :
La première s'active dès que tu changes quoi que ce soit sur la feuille
La seconde s'active quand tu fait un double-clic sur la feuille
 

rubis54

XLDnaute Occasionnel
Tu vas remplacer tout le code de la feuille "Sortie du Jour" par celui-ci :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
   
    If Target.Address = [B2].Address Then
        Range("D2:D" & WorksheetFunction.Max(2, Cells(Rows.Count, "D").End(xlUp).Row)).Clear
        [Tableau2].ListObject.Range.AutoFilter
        [Tableau2].ListObject.Range.AutoFilter Field:=2, Criteria1:="=" & [B2] & "*", Operator:=xlAnd
        [Tableau2].ListObject.Range.AutoFilter Field:=5, Criteria1:=">0", Operator:=xlAnd
        [Tableau2[Désignation]].SpecialCells(xlCellTypeVisible).Copy [D2]
        [Tableau2].ListObject.Range.AutoFilter
    End If
   
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim Ligne As Integer:
   
    If Target.Count = 1 Then
        Ligne = Range("D" & Rows.Count).End(xlUp).Row
        If Not Intersect(Target, Range("D1:D" & Ligne)) Is Nothing Then
            Ligne = Range("F" & Rows.Count).End(xlUp).Row
            Range("F" & Ligne + 1).Value = Target
            Range("G" & Ligne + 1).Activate
        End If
    End If
    Cancel = True
   
End Sub

Et n'essayes pas de les exécuter, ce sont des macros événementielles :
La première s'active dès que tu changes quoi que ce soit sur la feuille
La seconde s'active quand tu fait un double-clic sur la feuille
Re Fanch55,

Alors si je tombe sur un article lequel a un stock nul, il m'affiche l'image ci-dessous.
Peut-on pas faire en sorte que si on tombe sur un stock zéro qu'il m'affiche un MsgBox par exemple ?
 

Pièces jointes

  • stock nul.JPG
    stock nul.JPG
    115.1 KB · Affichages: 25

fanch55

XLDnaute Barbatruc
Oki,
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.Address = [B2].Address Then
        Range("D2:D" & WorksheetFunction.Max(2, Cells(Rows.Count, "D").End(xlUp).Row)).Clear
        [Tableau2].ListObject.Range.AutoFilter
        [Tableau2].ListObject.Range.AutoFilter Field:=2, Criteria1:="=" & [B2] & "*", Operator:=xlAnd
        [Tableau2].ListObject.Range.AutoFilter Field:=5, Criteria1:=">0", Operator:=xlAnd
        On Error Resume Next
        [Tableau2[Désignation]].SpecialCells(xlCellTypeVisible).Copy [D2]
        [Tableau2].ListObject.Range.AutoFilter
    End If
    
End Sub
 

rubis54

XLDnaute Occasionnel
Oki,
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
   
    If Target.Address = [B2].Address Then
        Range("D2:D" & WorksheetFunction.Max(2, Cells(Rows.Count, "D").End(xlUp).Row)).Clear
        [Tableau2].ListObject.Range.AutoFilter
        [Tableau2].ListObject.Range.AutoFilter Field:=2, Criteria1:="=" & [B2] & "*", Operator:=xlAnd
        [Tableau2].ListObject.Range.AutoFilter Field:=5, Criteria1:=">0", Operator:=xlAnd
        On Error Resume Next
        [Tableau2[Désignation]].SpecialCells(xlCellTypeVisible).Copy [D2]
        [Tableau2].ListObject.Range.AutoFilter
    End If
   
End Sub
ça fonctionne Fanch55, Merci encore pour ton aide. Je vais mettre tout à jour et je reviendrai sur le forum car j'aimerai bien ajouter deux trois choses si possible.
A+
Cdt Rubis54
 

rubis54

XLDnaute Occasionnel
Bonjour rubis54
Bonjour le Fil,le forum

Pas sûr d'avoir compris lol
Mais dans les éléments d'une feuille tu ne peux avoir qu'une seule procédure événementielle de chaque type.
Exemple une seule

Il faut alors regrouper ce que tu veux faire lors de cet événement dans une seule procédure,ou de supprimer ce qui ne sert pas
Jean marie
Re Jean Marie,

je ne vois plus ton dernier message, tu veux bien me le renvoyer STP

Merci
Cdt Rubis54
 

fanch55

XLDnaute Barbatruc
Re
je ne suis pas un expert , mais on peut aussi tester s'il y a une Ligne Visible dans le DataBodyrange du Tableau ! plutôt qu'un "On error resume Next" Non ?
VB:
[Tableau2].ListObject.Range.AutoFilter Field:=5, Criteria1:=">0", Operator:=xlAnd
If [Tableau2[Désignation]].SpecialCells(xlCellTypeVisible).Rows.Count = 0 Then Exit Sub 'Ici
[Tableau2[Désignation]].SpecialCells(xlCellTypeVisible).Copy [D2]
jean marie
Salut Jean-Marie,
On se demande parfois si les différents dév d'Office ont un cahier de charge "abouti" avec des spécifs similaires.
Malheureusement,
dès qu'on fait appel à la propriété spécialcells,
on n'aura jamais count=0
car une erreur est tout de suite produite en ce cas .
Ce n'est pas propre indéniablement mais il faut vivre avec ...
1632917898542.png