Function DicoGig(ByVal Gigogne As Collection, Optional ByVal NivMax As Long = 256) As Dictionary
Dim SsGr As SsGr, TE(), TS(), L&, C&
Set SsGr = Gigogne(1)
Set DicoGig = New Dictionary
NivMax = NivMax - 1
If NivMax < 0 Then
For Each SsGr In Gigogne: DicoGig.Add SsGr.Id, SsGr.Co: Next SsGr
ElseIf TypeOf SsGr.Co(1) Is SsGr Then
For Each SsGr In Gigogne: DicoGig.Add SsGr.Id, DicoGig(SsGr.Co, NivMax): Next SsGr
Else
TE = SsGr.Co(1)
For Each SsGr In Gigogne: ReDim TS(1 To SsGr.Count, LBound(TE) To UBound(TE))
For L = 1 To SsGr.Count: TE = SsGr.Co(L)
For C = 1 To UBound(TS, 2): TS(L, C) = TE(C): Next C, L
DicoGig.Add SsGr.Id, TS: Next SsGr: End If
End Function
Option Explicit
Private WithEvents CLsC As ComboBoxLiées, LCouC As Long, TVLC(), TLC() As Long, _
WithEvents CLsE As ComboBoxLiées, LCouE As Long, TVLE(), TLE() As Long, _
WithEvents CLsA As ComboBoxLiées, LCouA As Long, TVLA(), TLA() As Long, _
WithEvents CLsI As ComboBoxLiées, LCouI As Long, TVLI(), TLI() As Long
Private DicA As Dictionary, DicI As Dictionary
Private Sub UserForm_Initialize()
Set CLsI = New ComboBoxLiées
CLsI.Plage [TblSuivStock]
CLsI.Add Me.CBxARéfArticle, 1, Croissant:=False
CLsI.Add Me.CBxEemplacement, 4
CLsI.CouleurSympa
CLsI.Actualiser
Set DicI = DicoSujet(CLsI.Item(CBxARéfArticle).SujetBdD)
End Sub
Private Sub CLsE_Résultat(Lignes() As Long)
Dim TDon(), TLBx(), Ldon As Long, LLBx As Long, C As Long
If UBound(Lignes) = 1 Then
LCouE = Lignes(1)
TVLE = CLsE.Lignes(LCouE).Range.Value
GarnirEntree
Else
TLE = Lignes
TDon = CLsE.PlgTablo.Value
ReDim TLBx(1 To UBound(TLE), 1 To 10)
For LLBx = 1 To UBound(TLE)
Ldon = TLE(LLBx)
For C = 1 To 10: TLBx(LLBx, C) = TDon(Ldon, C): Next C, LLBx ' code pour affichage total listbox changer paramètre 1To8 nb colonne affiché dans la list box
'For C = 1 To 7: TLBx(LLBx, C) = TDon(Ldon, Choose(C, 1, 2, 4, 5, 6, 8, 9)): Next C, LLBx 'choix des colonne à ressortir dans la listbox
LBxM.List = TLBx: End If
End Sub
Private Sub CBx_Change()
Parent.CBM_Change Me
End Sub
Private Sub CLsI_Résultat(Lignes() As Long)
Dim TDon(), TLBx(), Ldon As Long, LLBx As Long, C As Long
If UBound(Lignes) = 1 Then
LCouI = Lignes(1)
TVLI = CLsI.Lignes(LCouI).Range.Value
Else
TLI = Lignes
TDon = CLsI.PlgTablo.Value
ReDim TLBx(1 To UBound(TLI), 1 To 5)
For LLBx = 1 To UBound(TLI)
Ldon = TLI(LLBx)
For C = 1 To 5: TLBx(LLBx, C) = TDon(Ldon, C): Next C, LLBx ' code pour affichage total listbox changer paramètre 1To8 nb colonne affiché dans la list box
LBxI.List = TLBx: End If
End Sub
Private Sub CBnSupprimerE_Click()
If LCouE = 0 Then Exit Sub
If MsgBox("Etes-vous sûr de vouloir supprimer ce mouvement ?", _
vbYesNo + vbExclamation, Me.Caption) = vbNo Then Exit Sub
CLsE.Lignes(LCouE).Delete
CLsE.Actualiser
End Sub
Function DicALBxStock() As Dictionary
Dim TR(), RefArt As SsGr, DsgnArticle As String, Emplac As SsGr, LR As Long, TypMvt As SsGr, Détail
Set DicALBxStock = New Dictionary
For Each RefArt In Gigogne(WshSuivES, 1, 9, 5) 'Définition des colonnes de classement et regroupements (réf, emplacement, mouvement)
ReDim TR(1 To RefArt.Count, 1 To 3)
LR = 0
For Each Emplac In RefArt.Co ' Pour chaque SsGr d'emplacement de l'article
LR = LR + 1 ' Nouvelle ligne résultante (Incrémente le numéro de ligne du tableau dans lequel on écrit).
TR(LR, 1) = Emplac.Id
For Each TypMvt In Emplac.Co 'Pour chaque type de mouvement de cet emplacement
Select Case TypMvt.Id 'Selon cas du type de mouvement
Case "Entrée": TR(LR, 2) = TR(LR, 2) + TypMvt.Somme(8) 'Cas mouvement entrée: ajout somme des quantités des lignes détail
Case "Réservé": TR(LR, 2) = TR(LR, 2) + TypMvt.Somme(8) 'Cas mouvement réservé: ajout somme des quantités des lignes détail
Case "Sortie": TR(LR, 2) = TR(LR, 2) - TypMvt.Somme(8) 'Cas mouvement sortie: retrait somme des quantités des lignes détail
End Select 'Fin de bloc selon cas.
For Each Détail In TypMvt.Co 'Pour chaque ligne détail contenue dans ce type de mouvement
If Not IsEmpty(Détail(10)) Then TR(LR, 3) = Détail(10) 'Si la remarque n'est pas vide elle est placée en colonne 5
Next Détail, TypMvt, Emplac
DicALBxStock.Add RefArt.Id, TR: Next RefArt
End Function
Option Explicit
Private WithEvents CLsC As ComboBoxLiées, LCouC As Long, TVLC(), TLC() As Long, _
WithEvents CLsE As ComboBoxLiées, LCouE As Long, TVLE(), TLE() As Long, _
WithEvents CLsA As ComboBoxLiées, LCouA As Long, TVLA(), TLA() As Long,
'WithEvents CLsI As ComboBoxLiées, LCouI As Long, TVLI(), TLI() As Long
Private DicA As Dictionary, 'DicI As Dictionary
Private Sub UserForm_Initialize()
Set CLsA = New ComboBoxLiées
CLsA.Plage [TblBaseArticles]
CLsA.Add Me.CBxARéfArticle, 1, Croissant:=False
CLsA.Add Me.CBxADesArticle, 4
CLsA.CouleurSympa
CLsA.Actualiser
Set DicA = DicoSujet(CLsA.Item(CBxARéfArticle).SujetBdD)
If Not Me.ActiveControl Is FrmA Then CLsA.Stopper
Set CLsC = New ComboBoxLiées
CLsC.Plage [TblSuiviscommande]
CLsC.Add Me.CBxCRechecheRéfcommande, 1, Croissant:=False
CLsC.Add Me.CBxARéfArticle, 8
CLsC.Add Me.CBxADesArticle, 9
CLsC.CouleurSympa
CLsC.Actualiser
If Not Me.ActiveControl Is FrmC Then CLsC.Stopper
Set CLsE = New ComboBoxLiées
CLsE.Plage [TblSuivisEntreeSortis]
CLsE.Add Me.CBxARéfArticle, 1, Croissant:=False
CLsE.Add Me.CBxADesArticle, 2
CLsE.Add Me.CBxCRechecheRéfcommande, 4
CLsE.Add Me.CBxType, 5
CLsE.Add Me.CBxEDate, 6
CLsE.Add Me.CBxEemplacement, 9
CLsE.CouleurSympa
CLsE.Actualiser
If Not Me.ActiveControl Is FrmE Then CLsE.Stopper
Set DicI = DicILBxStock()
End Sub
Function DicILBxStock() As Dictionary 'Dictionnaire pour listbox Suivis Stock
Dim TR(), RefArt As SsGr, DsgnArticle As String, Emplac As SsGr, LR As Long, TypMvt As SsGr, Détail
Set DicILBxStock = New Dictionary
For Each RefArt In Gigogne(WshSuivES, 1, 9, 5) 'Définition des colonnes de classement et regroupements (réf, emplacement, mouvement)
ReDim TR(1 To RefArt.Count, 1 To 3)
LR = 0
For Each Emplac In RefArt.Co ' Pour chaque SsGr d'emplacement de l'article
LR = LR + 1 ' Nouvelle ligne résultante (Incrémente le numéro de ligne du tableau dans lequel on écrit).
TR(LR, 1) = Emplac.Id
For Each TypMvt In Emplac.Co 'Pour chaque type de mouvement de cet emplacement
Select Case TypMvt.Id 'Selon cas du type de mouvement
Case "Entrée": TR(LR, 2) = TR(LR, 2) + TypMvt.Somme(8) 'Cas mouvement entrée: ajout somme des quantités des lignes détail
Case "Réservé": TR(LR, 2) = TR(LR, 2) + TypMvt.Somme(8) 'Cas mouvement réservé: ajout somme des quantités des lignes détail
Case "Sortie": TR(LR, 2) = TR(LR, 2) - TypMvt.Somme(8) 'Cas mouvement sortie: retrait somme des quantités des lignes détail
End Select 'Fin de bloc selon cas.
For Each Détail In TypMvt.Co 'Pour chaque ligne détail contenue dans ce type de mouvement
If Not IsEmpty(Détail(10)) Then TR(LR, 3) = Détail(10) 'Si la remarque n'est pas vide elle est placée en colonne 5
Next Détail, TypMvt, Emplac
DicILBxStock.Add RefArt.Id, TR: Next RefArt
End Function