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

[dohurden]

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.

 

[Lone-wolf]

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

Bonsoir dohurden,

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

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.

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+

 

[Papou-net]

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.

 

[Lone-wolf]

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

Bonsoir Papou-net

 

[Papou-net]

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

Bonsoir Lone-wolf, et bonne soirée.