Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2013 possibilité addition ou soustraction de stock depuis un userform?

D

dohurden

XLDnaute Nouveau
Bonsoir,
Débutant en VBA je me permets de vous poser une question, parce que là je coince.
A la demande de mon patron, j'essaye de faire un tableau de suivi pour certains produits. dans mon classeur j 'ai une feuille nommer "stock" ou dessus j'ai différent critères m'intéressant. J'ai créé un formulaire userform nommé modification de stock accessible depuis ma page accueil. Dessus j'ai des infos que je peux sélectionner à l'aide de combobox liés en cascade, j'ai une case ou je peux voir mon stock initial, une case bien entendu quantité pour mes sorties ou mes entrées, deux boutons switch me permettant de choisir "entrée" ou "sortie" pour mon mouvement.
Ma question est la suivante, est-il possible par exemple en cochant la case entrée, que ma quantité sélectionnée s'additionne avec mon stock initial, s'affiche que ce nouveau stock s'affiche dans une textbox, et que lorsque je valide ce mouvement, le stock se mette à jour dans ma feuille stock, et inversement pour la sortie????
La j'avoue que je ne sais pas du tout comment faire, et c'est quasiment la dernière partie de mon classeur. Votre serait vraiment bien venue.

Je joins le fichier, cela aidera certainement pour illustrer mes propos.

Merci par avance.
 

Pièces jointes

  • Classeur1 V0.xlsm
    113.9 KB · Affichages: 76
  • Classeur1 V0.xlsm
    113.9 KB · Affichages: 76
Trier par date Trier par votes

Lone-wolf

XLDnaute Barbatruc
Re : possibilité addition ou soustraction de stock depuis un userform?

Bonsoir dohurden,

Oui c'est possible. Un exemple à adapter à ton projet.

Code: 
If CheckBox1.value = True then
With Sheets("Stock").Range("a2:g65000")
Set cel = Find(ComboBox4, , xlValues)  'ComboBox4 correpondant à 20-25-30-35Kg
If not cel Is Nothing Then
cel.offset(0, 4).value = cel.offset(0, 4).value + Val(TxtEntrees)  'Colonne Entrées
cel.offset(0, 5).value = cel.offset(0, 5).value + Val(TxtSorties)   'Colonne Sorties
End if
End With
End If

Voici une autre façon de faire avec une TextBox pour la recherche.

Code: 
Private Sub UserForm_Initialize()
    Dim chemin As String, i As Integer
    chemin = ThisWorkbook.Path & "\Images\fond.gif"
    Me.Picture = LoadPicture(chemin)
    Me.PictureSizeMode = fmPictureSizeModeStretch

    With Me.ListView1
        .Gridlines = True
        .View = lvwReport
        .FullRowSelect = True
        .ColumnHeaders.Add Text:="ID", Width:=35
        .ColumnHeaders.Add Text:="Produits", Width:=98
        .ColumnHeaders.Add Text:="Entrées", Width:=45, Alignment:=fmAlignmentRight
        .ColumnHeaders.Add Text:="Sorties", Width:=42, Alignment:=fmAlignmentRight
        .ColumnHeaders.Add Text:="Stock Réel", Width:=52, Alignment:=fmAlignmentRight
    End With
End Sub

Private Sub UserForm_Activate()
    Application.ScreenUpdating = False

    With Me.ListView1
        lig = Sheets("Stock").Range("a65536").End(xlUp).Row
        For Each cel In Sheets("Stock").Range("a2:a" & lig)
            i = i + 1
            .ListItems.Add , , cel
            .ListItems(i).ListSubItems.Add , , cel.Offset(0, 1)
            .ListItems(i).ListSubItems.Add , , cel.Offset(0, 4)
            .ListItems(i).ListSubItems.Add , , cel.Offset(0, 5)
            .ListItems(i).ListSubItems.Add , , cel.Offset(0, 6)
        Next cel
    End With

    Application.ScreenUpdating = True
End Sub

Private Sub TxtNumero_Change()
    Dim v As String, cel As Range
    v = Len(TxtNumero.Text)
    If v = 6 Then
        Set cel = Sheets("Stock").Columns("A").Find(What:=TxtNumero)
        If Not cel Is Nothing Then
            TxtArticles = cel.Offset(0, 1)
            'TxtEntrees = cel.Offset(0, 6)
        End If
        TxtSorties.SetFocus
    End If
End Sub

Private Sub Entrees_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    Me.Entrees.SpecialEffect = fmSpecialEffectRaised
End Sub

Private Sub Entrees_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    Dim i As Integer, j As Integer, lig As Integer, cel As Range
    Me.Entrees.SpecialEffect = fmSpecialEffectSunken
    Set cel = Sheets("Stock").Columns("A").Find(What:=TxtNumero)
    If Not cel Is Nothing Then
        cel.Offset(0, 4) = Val(TxtEntrees) + cel.Offset(0, 4)
        cel.Offset(0, 6) = Val(TxtEntrees) + cel.Offset(0, 6)
        ListView1.ListItems(cel.Offset.Row - 1).ListSubItems(2).Text = cel.Offset(0, 4)
        ListView1.ListItems(cel.Offset.Row - 1).ListSubItems(4).Text = cel.Offset(0, 6)
    End If

    With Sheets("Recap")
        lig = .Range("a65536").End(xlUp).Row
        .Cells(lig, 1).Value = Val(TxtNumero)
        .Cells(lig, 2).Value = TxtArticles.Text
        .Cells(lig, 3).Value = Date
        .Cells(lig, 4).Value = Val(TxtEntrees)
    End With

    TxtNumero = ""
    TxtSorties = ""
    TxtArticles = ""
    TxtEntrees = ""
    TxtNumero.SetFocus

End Sub

Private Sub Sorties_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    Dim lig As Integer, i As Integer, j As Integer, cel As Range
On Error Resume Next
    Me.Sorties.SpecialEffect = fmSpecialEffectRaised
    If Me.Sorties <> "" Then
        Set cel = Sheets("Stock").Columns("A").Find(What:=TxtNumero)
        If Not cel Is Nothing Then
            cel.Offset(0, 5) = cel.Offset(0, 5) + Val(TxtSorties)
            cel.Offset(0, 6) = cel.Offset(0, 6) - Val(TxtSorties)
            ListView1.ListItems(cel.Offset.Row - 1).ListSubItems(3).Text = cel.Offset(0, 5)
            ListView1.ListItems(cel.Offset.Row - 1).ListSubItems(4).Text = cel.Offset(0, 6)

            If cel.Offset(0, 6) <= cel.Offset(0, 3) Then: _
                    MsgBox "Veuillez réapprovisionner le Stock.", , "La Gondolière": TxtEntrees = ""
        End If

        With Sheets("Recap")
            lig = .Range("a65536").End(xlUp).Row
            .Cells(lig, 1).Value = Val(TxtNumero)
            .Cells(lig, 2).Value = TxtArticles.Text
            .Cells(lig, 5).Value = Date
            .Cells(lig, 6).Value = Val(TxtSorties)
        End With

        TxtNumero = ""
        TxtSorties = ""
        TxtArticles = ""
        TxtEntrees = ""
        TxtNumero.SetFocus
    End If

End Sub

Private Sub Sorties_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    Me.Sorties.SpecialEffect = fmSpecialEffectSunken
End Sub

Private Sub Modifier_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    Dim lig As Long, cel As Range, c As Range, difSort
    Static dif

    Me.Modifier.SpecialEffect = fmSpecialEffectRaised

    Set cel = Sheets("Stock").Columns("A").Find(What:=TxtNumero)
    If Not cel Is Nothing Then
        dif = cel.Offset(0, 5)     'Mémorisation de la première entrée dans TxtSorties
        difSort = dif - Val(TxtSorties)
        cel.Offset(0, 0) = Val(TxtNumero)
        cel.Offset(0, 1) = TxtArticles
        cel.Offset(0, 2) = cel.Offset(0, 2)
        cel.Offset(0, 3) = cel.Offset(0, 3)
        cel.Offset(0, 4) = Val(TxtEntrees)
        cel.Offset(0, 5) = Val(TxtSorties)
        cel.Offset(0, 6) = cel.Offset(0, 6) + difSort
        ListView1.ListItems(cel.Offset.Row - 1).ListSubItems(3).Text = cel.Offset(0, 5)
        ListView1.ListItems(cel.Offset.Row - 1).ListSubItems(2).Text = cel.Offset(0, 4)
        ListView1.ListItems(cel.Offset.Row - 1).ListSubItems(4).Text = cel.Offset(0, 6)
    End If

    On Error Resume Next
    Set c = Sheets("Recap").Columns("A").Find(What:=TxtNumero)
    If Not c Is Nothing Then
        c.Offset(0, 0) = Val(TxtNumero)
        c.Offset(0, 1) = TxtArticles
        c.Offset(0, 2) = c.Offset(0, 2)
        c.Offset(0, 3) = Val(TxtEntrees)
        c.Offset(0, 4) = cel.Offset(0, 4)
        c.Offset(0, 5) = Val(TxtSorties)
    End If
    TxtNumero = ""
    TxtSorties = ""
    TxtArticles = ""
    TxtEntrees = ""
    Set dif = Nothing
    Set difSort = Nothing
    TxtNumero.SetFocus

End Sub

Private Sub Modifier_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    Me.Modifier.SpecialEffect = fmSpecialEffectSunken
End Sub

Private Sub Annuler_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    Me.Annuler.SpecialEffect = fmSpecialEffectRaised
    TxtNumero = ""
    TxtSorties = ""
    TxtArticles = ""
    TxtEntrees = ""
    TxtNumero.SetFocus
End Sub

Private Sub Annuler_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    Me.Annuler.SpecialEffect = fmSpecialEffectSunken
End Sub

Private Sub Supprimer_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    Dim Plage As Range, cel As Range, difEnt
    Dim Msg As Integer, ctrl As Control
    Static dif

    Me.Supprimer.SpecialEffect = fmSpecialEffectRaised

    Set Plage = Sheets("Stock").Range("A2:A" & Range("A65536").End(xlDown).Row).Find(TxtNumero.Value)
    For Each cel In Plage
        dif = Val(TxtEntrees)
        difEnt = Val(TxtEntrees) - dif
        cel.Offset(0, 6) = cel.Offset(0, 6) + cel.Offset(0, 4)
        Msg = MsgBox("Êtes-vous sûr de vouloir supprimer les données ?", vbYesNo, "La Gondolière")
        If Msg = 6 Then
            cel.Offset(0, 4).ClearContents
            cel.Offset(0, 5).ClearContents
            MsgBox "Données supprimées.", vbOK, "La Gondolière"
            If Msg = 7 Then Exit Sub
            cel.Offset(0, 4) = difEnt
        End If
    Next cel
    For Each ctrl In Me.Controls
        If TypeName(ctrl) = "TextBox" Then: ctrl.Value = ""
    Next ctrl
    Set dif = Nothing
    Set difEnt = Nothing
End Sub

Il est préférable d'avoir un code pour chaque article, afin que la recherche soit plus rapide, comme tu peux le voir en image





A+
 

Pièces jointes

  • Sans titre.gif
    45 KB · Affichages: 73
Dernière édition:
Vote positif 0 Vote négatif

Papou-net

XLDnaute Barbatruc
Re : possibilité addition ou soustraction de stock depuis un userform?

Bonsoir dohurden,

Ci-joint ton fichier avec ajout des macros demandées.

Bonne soirée.

Cordialement.
 

Pièces jointes

  • Copie de Classeur1 V0.xlsm
    115.8 KB · Affichages: 109
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

R
  • Question
Microsoft 365 Couverture de stock
Réponses
0
Affichages
219
romubzh35
R
  • Question
Microsoft 365 Gestion de Stock
Réponses
2
Affichages
2 K
gael56000
  • Résolu(e)
XL 2013 Gestion de stock sous excel
2
Réponses
18
Affichages
1 K
Jsquare
L
  • Résolu(e)
XL 2021 Aide VBA pour appli Gestion de stock
Réponses
2
Affichages
356
LuckyShuri
L
E
  • Résolu(e)
XL 2019 transfer listbox vers une colonne à partir de la 4 ligne
Réponses
2
Affichages
135
escudo
E
G
  • Question
Microsoft 365 Reconstitution stock a date - besoin d'aide
Réponses
0
Affichages
461
GregH
G
M
  • Question
Microsoft 365 Afficher les données d'un userform sur un autre userform
Réponses
3
Affichages
424
Manon71.
M
S
  • Question
Microsoft 365 Formule Gestion de Stock
Réponses
2
Affichages
1 K
Schwalby
S
M
  • Question
XL 2019 Images dans plusieurs cellules à partir de plusieurs URL
2
Réponses
15
Affichages
803
patricktoulon
M
  • Question
Microsoft 365 un exemple Excel de répartition de médicament pour une pharmacie
Réponses
2
Affichages
432
monsef JABBOUR
M
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…