Dim Auto As Boolean, TbRés()
Private Sub UserForm_Initialize()
'Lecture des données du tableau de suivi
Tb = Sh_Suivi.[Tb_Suivi]
'Nbre de lignes du tableau
NbL = UBound(Tb)
Auto = True
'Cas du tableau vide
If Tb(1, 1) = "" And NbL = 1 Then
With Me
.CkB_Nouveau = True
.CkB_Nouveau.Enabled = False
.CBx_N° = Format(1, "00000")
.CBx_N°.Enabled = False
End With
Else
'Cas du tableau contenant déjà des données
ReDim TbN°(1 To NbL)
For i = 1 To UBound(Tb)
'Dictionnaire des N° de transport (N° de transport, Index de la ligne)
DcN°(Format(Tb(i, Col_N°), "00000")) = i
Next
With Me
'initialisation de la ComboBox Liste des N°
.CBx_N°.List = DcN°.Keys
'Initialiation de la case à cocher Nouveau Transport
.CkB_Nouveau = False
.CkB_Nouveau.Enabled = True
End With
'Affiche la dernière ligne du tableau
AfficheNum (UBound(Tb, 1))
End If
Auto = False
End Sub
Private Sub CBn_Enregistrer_Click()
'Lire tous les champs du formulaire (résultats dans TbRés)
LireUsF
With Me
If .CkB_Nouveau Then
'Nouveau N° coché ...
If TbRés(1, Col_Projet) = "" Or TbRés(1, Col_Division) = "" Then MsgBox "Renseigner au moins Projet et Division !": Exit Sub
'Ajoute une ligne au tableau de suivi si il y a déjà des lignes renseignées
If Not Evaluate("AND(ISBLANK(tb_Suivi))") Then Sh_Suivi.ListObjects("Tb_Suivi").ListRows.Add
'Remplit la dernière ligne (vide) du tableau de suivi
With Sh_Suivi.[Tb_Suivi]
.Rows(.Rows.Count).Value = TbRés
Tb = .Value
End With
'Ajoute une clef au dictionnaire
DcN°(Format(TbRés(1, Col_N°), "00000")) = UBound(Tb, 1)
Auto = True
'Réactive les contrôles du formulaire (désactivé par le choix nouveau transport)
.CkB_Nouveau.Enabled = True
.CBx_N°.Enabled = True
.CkB_Nouveau = False
'Actualise la liste du choix des N°
.CBx_N°.List = DcN°.Keys
Auto = False
Else
'Enregistre les modifications effectuées (si N° sélectionné)
If TbRés(1, Col_N°) = "" Then MsgBox "Pas de N° séléctionné !": Exit Sub
Sh_Suivi.[Tb_Suivi].Rows(DcN°(.CBx_N°.Text)) = TbRés
Tb = Sh_Suivi.[Tb_Suivi]
End If
End With
End Sub
Private Sub CBn_Annuler_Click()
Me.Hide
End Sub
Private Sub CBx_N°_Change()
If Auto Then Exit Sub
Auto = True
'Affiche le N° choisi (index via le dictionnaire DCN°)
AfficheNum (CLng(DcN°(Me.CBx_N°.Text)))
Auto = False
End Sub
Private Sub CkB_Nouveau_Click()
If Auto Then Exit Sub
Auto = True
If Me.CkB_Nouveau Then
'Cas d'un nouveau N°
'Vide le formulaire des anciennes valeurs
EffacerUsF
'Trouve le nouveau N° de transport
With WorksheetFunction
N° = .Max(.Index(Sh_Suivi.[Tb_Suivi], 0, 1)) + 1
End With
'Affiche et verrouille le nouveau N°
Me.CBx_N° = Format(N°, "00000")
Me.CBx_N°.Enabled = False
Else
'Cas du décochage de la case Nouveau transport
'Active le choix du N° et affiche le dernier enregistrement
Me.CBx_N°.Enabled = True
AfficheNum (UBound(Tb, 1))
End If
Auto = False
End Sub
Sub AfficheNum(Idx As Long)
'Affiche de la ligne repérée par son index dans le tableau vb "Tb" (données du tableau structuré tb_Suivi)
With Me
.CBx_N°.Text = Format(Tb(Idx, Col_N°), "00000")
.CBx_Suffixe = Tb(Idx, Col_Suffixe)
.CBx_Projet = Tb(Idx, Col_Projet)
.CBx_Division = Tb(Idx, Col_Division)
.TBx_Poids = Tb(Idx, Col_Poids)
.TBx_Destination = Tb(Idx, Col_Destination)
.CBx_Transporteur = Tb(Idx, Col_Transporteur)
.CBx_Equipement_requis = Tb(Idx, Col_Equipement_requis)
.TBx_Départ = IIf(IsEmpty(Tb(Idx, Col_Parti_le)), "", Format(Tb(Idx, Col_Parti_le), "dd/mm/yyyy"))
.TBx_Arrivée = IIf(IsEmpty(Tb(Idx, Col_Arrivé_le)), "", Format(Tb(Idx, Col_Arrivé_le), "dd/mm/yyyy"))
.TBx_N°_BOL_ou_PO = Tb(Idx, Col_N°_BOL_ou_PO)
.TBx_Remorque = Tb(Idx, Col_Remorque)
.TBx_Valeur = Tb(Idx, Col_Valeur)
.TBx_N°_Facture = Tb(Idx, Col_N°_Facture)
.TBx_Approuvé_le = Tb(Idx, Col_Approuvé_le)
End With
End Sub
Sub EffacerUsF()
'Vide les champs modifiables du formulaire
With Me
.CBx_N°.Text = ""
.CBx_Suffixe = ""
.CBx_Projet = ""
.CBx_Division = ""
.TBx_Poids = ""
.TBx_Destination = ""
.CBx_Transporteur = ""
.CBx_Equipement_requis = ""
.TBx_Départ = ""
.TBx_Arrivée = ""
.TBx_N°_BOL_ou_PO = ""
.TBx_Remorque = ""
.TBx_Valeur = ""
.TBx_N°_Facture = ""
.TBx_Approuvé_le = ""
End With
End Sub
Sub LireUsF()
'Lit les champs du formulaire et place le résultat dans le tableau vb "TbRés"
ReDim TbRés(1 To 1, 1 To UBound(Tb, 2))
With Me
TbRés(1, Col_N°) = CLng(.CBx_N°)
TbRés(1, Col_Suffixe) = .CBx_Suffixe
TbRés(1, Col_Projet) = .CBx_Projet
TbRés(1, Col_Division) = .CBx_Division
If .TBx_Poids <> "" Then TbRés(1, Col_Poids) = CDbl(Replace(Replace(.TBx_Poids, ".", ","), ",", Application.DecimalSeparator))
TbRés(1, Col_Destination) = .TBx_Destination
TbRés(1, Col_Transporteur) = .CBx_Transporteur
TbRés(1, Col_Equipement_requis) = .CBx_Equipement_requis
If .TBx_Départ <> "" Then TbRés(1, Col_Parti_le) = CDate(.TBx_Départ)
If .TBx_Arrivée <> "" Then TbRés(1, Col_Arrivé_le) = CDate(.TBx_Arrivée)
TbRés(1, Col_N°_BOL_ou_PO) = .TBx_N°_BOL_ou_PO
TbRés(1, Col_Remorque) = .TBx_Remorque
TbRés(1, Col_Valeur) = .TBx_Valeur
TbRés(1, Col_N°_Facture) = .TBx_N°_Facture
TbRés(1, Col_Approuvé_le) = .TBx_Approuvé_le
End With
End Sub