Private Sub MajInventaire()
Dim QS&, n&, v
With Worksheets("Inventaire")
flgAdd = 0
n = UBound(TblInv): lgS = 0: lgD = 0
GetLig ComboBox1, n, lgS: If lgS = 0 Then Exit Sub
GetLig ComboBox2, n, lgD: If lgD > 0 Then flgAdd = 1
If lgD = 0 Then
flgAdd = 0: lgD = n + 3
If lgD = 65000 Then
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, 11) ' était (lgS, 3)
QS = .Value + QT: .Value = QS: stocktr = QS
End With
Application.EnableEvents = False
.Activate ' active la feuille
If flgAdd = 0 Then
' insère une ligne
.Rows("4:4").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Unprotect
.Rows("5:5").Copy ' copie la ligne en dessous
.Rows("4:4").PasteSpecial xlPasteFormats ' colle le format
.Range("D5").Copy ' copie la cellule
.Range("D4").Select ' sélectionne la cellule
ActiveSheet.Paste ' colle (formule incluse)
Application.EnableEvents = True
lgD = 4
End If
For v = 0 To ListBox1.ListCount - 1
With .Cells(lgD, 3)
If flgAdd = 0 Then
.Offset(, -2) = ListBox1.List(v, 3) 'Code article
.Offset(, -1) = ListBox1.List(v, 4) 'Catégorie
.Offset(, 2) = ListBox1.List(v, 5) 'Seuil d'alerte
.Offset(, 3) = ListBox1.List(v, 6) 'Descriptif
.Offset(, 4) = ListBox1.List(v, 7) 'Référence
.Offset(, 5) = ListBox1.List(v, 8) 'Unité de mesure
.Offset(, 6) = "Transfert" 'Observations
.Offset(, 9) = ComboBox2 'Magasin
QD = Val(.Value) + QT: .Value = QD 'Stock actuel
Else
.Offset(, 7) = .Offset(, 7) + Quantitetr '
End If
lgT = lgT + 1
End With
.Protect: Application.ScreenUpdating = -1
Next
End With
End Sub
Private Sub LigneTransfert()
Dim v
'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")
'Lastrow = Range("a" & Rows.Count).End(xlUp).Row + 1
lgT = .Cells(Rows.Count, 1).End(3).Row + 1
For v = 0 To ListBox1.ListCount - 1
If lgT = 650000 Then
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 = ListBox1.List(v, 1) 'Code article
.Offset(, 1) = ListBox1.List(v, 2) 'Catégorie
.Offset(, 2) = ListBox1.List(v, 3) 'Désignation
.Offset(, 3) = ListBox1.List(v, 4) 'Référence
' .Offset(, 4) = ListBox1.List(v, 4) 'Stock actuel
.Offset(, 5) = ListBox1.List(v, 7) 'Unité
.Offset(, 6) = Date 'Date
.Offset(, 7) = ComboBox1 'Provenance
.Offset(, 8) = ComboBox2 'Destination
.Offset(, 9) = QT '= ListBox1.List(v, 13) 'Quantité transférée
'.Offset(, 10) = Stock2 'STOCK PR
' .Offset(, 11) = QD 'STOCK DES
.Offset(, 12) = TextBox1
.Offset(, 13) = Format(Now, "mm/dd/yyyy hh:mm am/pm")
lgT = lgT + 1
End With
.Protect: Application.ScreenUpdating = -1
Next
End With
End Sub
Private Sub UndoOpInv()
Application.ScreenUpdating = 0
With Worksheets("Inventaire")
.Unprotect
With .Cells(lgS, 3): .Value = .Value + QT: End With
With .Cells(lgD, 3)
If flgAdd Then .Offset(, -3).Resize(, 12).ClearContents _
Else .Value = .Value - QT
End With
.Protect
End With
Application.ScreenUpdating = -1
End Sub
