Option Explicit
'
Private Sub BtConstLstCmd_Click()
Dim Ts() As Variant, Le As Long, Ls As Long, LAct As Long
ReDim Ts(1 To FLstPcD.[CodesPièces].Rows.Count, 1 To 3) As Variant
Ls = 0
For Le = 1 To FLstPcD.[CodesPièces].Rows.Count
If FLstPcD.[StockDispo].Rows(Le).Value < FLstPcD.[StockMini].Rows(Le).Value Then
Ls = Ls + 1
Ts(Ls, 1) = FLstPcD.[CodesPièces].Rows(Le)
Ts(Ls, 2) = FLstPcD.[DésignPièces].Rows(Le)
Ts(Ls, 3) = FLstPcD.[QtéCmd].Rows(Le)
End If
Next Le
If Ls < 2 Then Ls = 2
LAct = Me.[CodeACd].Rows.Count
If LAct < Ls Then
Me.[CodeACd].Rows(LAct).EntireRow.Resize(Ls - LAct).Insert
ElseIf LAct > Ls Then
Me.[CodeACd].Rows(2).EntireRow.Resize(LAct - Ls).Delete
End If
Me.[CodeACd:QtéACd].Value = Ts
End Sub
'
Private Sub BtImporter_Click()
ImporterFCtrl Me
Me.[DésignACd].FormulaR1C1 = "=INDEX(DésignPièces,MATCH(CodeACd,CodesPièces,0))"
End Sub
'
Private Sub BtMàjStock_Click()
Dim SgnMvt As Long, Heure As Date, Stock As Long, CodePièce As String, Qté As Long, Lc As Long, Lm As Long, La As Long
SgnMvt = 1
Heure = Now
For Lm = 1 To Me.[CodeACd].Rows.Count
CodePièce = Me.[CodeACd].Rows(Lm).Value
On Error Resume Next
Lc = WorksheetFunction.Match(CodePièce, FLstPcD.[CodesPièces], 0)
If Err Then
Rem. Disposition en cas de
MsgBox "Pièce """ & CodePièce & """ non répertoriée en stock.", vbExclamation, "Approvisionnements"
GoTo Suivant: End If
On Error GoTo 0
Stock = FLstPcD.[StockDispo].Rows(Lc).Value
Qté = Me.[QtéACd].Rows(Lm).Value * SgnMvt
Stock = Stock + Qté
FLstPcD.[StockDispo].Rows(Lc).Value = Stock
With FArch.[Tablo]: La = .Rows.Count: .Rows(La).Copy: .Rows(La).Insert
La = .Rows(La + 1).Row: End With
FArch.[Heure].Rows(La).Value = Heure
FArch.[Code].Rows(La).Value = CodePièce
FArch.[Qté].Rows(La).Value = Qté
FArch.[Stock].Rows(La).Value = Stock
FLstPcD.[DatDrnMvt].Rows(Lc).Value = Heure
FLstPcD.[QtéDrnMvt].Rows(Lc).Value = Qté
Suivant: Next Lm
End Sub