Option Explicit
Dim TblInv, QT&, QD&, lgS&, lgD&, lgT&, flgAdd As Boolean
Private Sub Bouton_Recherche_Pièce_Click()
ModeSaisieAuto = "Pièce Transfer"
With UF_Saisie_Auto
.Caption = "Recherche dans l'inventaire": .TB_Texte = "": .Show
End With
End Sub
Private Sub Bouton_Recherche_Pièce_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = 27 Then Unload Me
End Sub
Private Sub ListMagD()
Dim n&, i&: ComboBox2.Clear
With Worksheets("Compte magasin")
n = .Cells(Rows.Count, 2).End(3).Row
For i = 2 To n
With .Cells(i, 2)
If .Value <> ComboBox1 Then ComboBox2.AddItem .Value
End With
Next i
End With
ComboBox2.SetFocus
End Sub
Private Sub MajStkProv()
Dim i&
For i = 1 To UBound(TblInv)
If TblInv(i, 1) = CB_Pièce Then
If TblInv(i, 12) = ComboBox1 Then
stocktr = TblInv(i, 4): Exit For
End If
End If
Next i
End Sub
Private Sub CB_Pièce_Change()
On Error Resume Next
ComboBox2.Clear: Quantitetr = ""
catetr = "": Desitr = "": reftr = "": stocktr = "": unitr = ""
With ComboBox1
.Clear
If CB_Pièce = "Code article" Then
.AddItem "Magasin": .ListIndex = 0: Exit Sub
End If
Dim i&
For i = 1 To UBound(TblInv)
If TblInv(i, 1) = CB_Pièce Then
.AddItem TblInv(i, 12) 'crée la liste magasin Provenance
'écrit les infos des 5 labels (seulement s'ils sont vides)
If catetr = "" Then catetr = TblInv(i, 2) 'Catégorie
If Desitr = "" Then Desitr = TblInv(i, 6) 'Désignation
If reftr = "" Then reftr = TblInv(i, 7) 'Référence
If stocktr = "" Then stocktr = TblInv(i, 4) 'Stock Provenance
If unitr = "" Then unitr = TblInv(i, 8) 'Unité
End If
Next i
.ListIndex = 0
End With
End Sub
Private Sub ComboBox1_Change()
Quantitetr = "": If catetr = "" Then Exit Sub
Call MajStkProv: ListMagD
End Sub
Private Sub GetLig(Mag$, n&, lg2&)
Dim i&
For i = 1 To n
If TblInv(i, 1) = CB_Pièce Then
If TblInv(i, 12) = Mag Then lg2 = i + 2: Exit For
End If
Next i
End Sub
Private Sub MajInventaire()
Dim QS&, n&
With Worksheets("Inventaire")
n = UBound(TblInv): lgS = 0: lgD = 0
GetLig ComboBox1, n, lgS: If lgS = 0 Then Exit Sub
GetLig ComboBox2, n, lgD: flgAdd = 0
If lgD = 0 Then
flgAdd = -1: lgD = n + 3
If lgD = 26 Then '26 = n° de la ligne en bleu clair (en bas)
MsgBox "Le tableau en feuille Inventaire est plein !", 48
lgD = 0: Exit Sub 'on fait rien, et on sort de la sub !
End If
End If
Application.ScreenUpdating = 0: .Unprotect: QT = Val(Quantitetr)
With .Cells(lgS, 4)
QS = .Value - QT: .Value = QS: stocktr = QS
End With
With .Cells(lgD, 4)
If flgAdd Then
.Offset(, -3) = CB_Pièce 'Code article
.Offset(, -2) = catetr 'Catégorie
.Offset(, 1) = TblInv(lgS - 3, 5) 'Seuil d'alerte
.Offset(, 2) = Desitr 'Descriptif
.Offset(, 3) = reftr 'Référence
.Offset(, 4) = unitr 'Unité de mesure
.Offset(, 5) = "Transfert" 'Observations
.Offset(, 8) = ComboBox2 'Magasin
End If
QD = Val(.Value) + QT: .Value = QD 'Stock actuel
End With
.Protect: Application.ScreenUpdating = -1
End With
End Sub
Private Sub LigneTransfert()
'remplir une ligne sur le tableau de la feuille "Transfert",
'mais s'il n'y a plus de ligne libre, on ne fait rien !
With Worksheets("Transfert")
lgT = .Cells(Rows.Count, 1).End(3).Row + 1
If lgT = 24 Then '24 = n° de la ligne en bleu clair (en bas)
MsgBox "Le tableau en feuille Transfert est plein !", 48
lgT = 0: Exit Sub 'on fait rien, et on sort de la sub !
End If
Dim Stock1&, Stock2&
Application.ScreenUpdating = 0: .Unprotect
Stock2 = Val(stocktr): Stock1 = Stock2 + QT
With .Cells(lgT, 1)
.Value = CB_Pièce 'Code article
.Offset(, 1) = catetr 'Catégorie
.Offset(, 2) = Desitr 'Désignation
.Offset(, 3) = reftr 'Référence
.Offset(, 4) = Stock1 'Stock actuel
.Offset(, 5) = unitr 'Unité
.Offset(, 6) = Date 'Date
.Offset(, 7) = ComboBox1 'Provenance
.Offset(, 8) = ComboBox2 'Destination
.Offset(, 9) = QT 'Quantité transférée
.Offset(, 10) = Stock2 'STOCK PR
.Offset(, 11) = QD 'STOCK DES
End With
.Protect: Application.ScreenUpdating = -1
End With
End Sub
Private Sub UndoOpInv()
Application.ScreenUpdating = 0
With Worksheets("Inventaire")
.Unprotect
With .Cells(lgS, 4): .Value = .Value + QT: End With
With .Cells(lgD, 4)
If flgAdd Then .Offset(, -3).Resize(, 12).ClearContents _
Else .Value = .Value - QT
End With
.Protect
End With
Application.ScreenUpdating = -1
End Sub
Private Sub CommandButton1_Click()
If CB_Pièce = "Code article" Then
MsgBox "Veuillez choisir un Code article.", 64, "Article requis": CB_Pièce.SetFocus: Exit Sub
End If
If Val(stocktr) = 0 Then MsgBox "Stock provenance vide => retrait impossible !": Exit Sub
If ComboBox2 = "" Then MsgBox "Veuillez choisir un Magasin de destination.": Exit Sub
Dim T$, Qté&, chn$, b As Byte: T = "Contrôle Quantité"
chn = Quantitetr: If chn = "" Then MsgBox "Veuillez saisir une Quantité.", 64, T: Quantitetr.SetFocus: Exit Sub
chn = Replace$(chn, ",", "."): If InStr(chn, ".") > 0 Then b = 1 'ni « , » ni « . » car Qté : nombre entier !
Qté = Val(chn): If Qté = 0 Then b = 1 'si chn est du texte ou 0, alors Qté = 0 => refusé !
If b = 1 Then
MsgBox "Veuillez entrer une quantité valide !", 64, T
Quantitetr = "": Quantitetr.SetFocus: Exit Sub
End If
If Qté > Val(stocktr.Caption) Then
MsgBox "Quantité supérieure au stock actuel !", 64, T
Quantitetr = "": Quantitetr.SetFocus: Exit Sub
End If
'si y'a pas eu d'écriture sur "Inventaire", on quitte cette sub SANS
Call MajInventaire: If lgD = 0 Then Exit Sub 'appeler LigneTransfert
Call LigneTransfert: If lgT = 0 Then UndoOpInv
'ci-dessus : si y'a pas eu d'écriture sur "Transfert", faut ANNULER
'l'opération qui a été faite sur "Inventaire", car une opération de
'transfert n'est PAS valable si on n'a pas pu l'écrire sur une des
'deux feuilles "Inventaire" ou "Transfert".
End Sub
Private Sub UserForm_Initialize()
Dim dik, dlg&, i&: Application.ScreenUpdating = 0
Set dik = CreateObject("Scripting.Dictionary")
With Worksheets("Inventaire")
dlg = .Cells(Rows.Count, 1).End(3).Row
If dlg = 3 Then MsgBox "Il n'y a aucun article.", 64, "Inventaire vide": Exit Sub
TblInv = .Range("A3:L" & dlg)
End With
Datetr = Date: Mid$(TblInv(1, 1), 5, 1) = " "
For i = 1 To UBound(TblInv)
If TblInv(i, 1) <> "" Then dik(TblInv(i, 1)) = ""
Next i
With CB_Pièce
.List = dik.Keys: .ListIndex = 0
End With
End Sub
Private Sub UserForm_Activate()
Left = 375: Top = 204
End Sub
ça a été très long car c'est assez complexe
tu vas bientôt
