Private Sub UserForm_Initialize()
Set Excel = Application
Set CL = New ComboBoxLiés
CL.Plage Sheet1.rows(2)
CL.Add Me.CbxAppella, 2
CL.Add Me.CbxDomaine, 3
CL.Add Me.CbxMillésim, 4
CL.Add Me.CbxDsgnCru, 5
CL.Add Me.CbxRégion, 6
CL.Add Me.CbxConten, 7
CL.Add Me.CbxLaRobe, 8
CL.CouleurSympa
CL.Actualiser
End Sub
Private Sub CL_Change(ByVal Complet As Boolean, ByVal NbrLgn As Long)
Select Case NbrLgn
Case 0: If Complet Then LabInfoIdt = "C'est une nouveauté…" Else LabInfoIdt = "Choisir…"
Case Is > 1: LabInfIdt = NbrLgn & " cas. Veuillez affiner la recherche…"
Case Else: Exit Sub
End Select
LCou = 0: GarnirChamps
End Sub
Private Sub CL_Résultat(Lignes() As Long)
If UBound(Lignes) <> 1 Then Exit Sub
LCou = Lignes(1): GarnirChamps
End Sub
Private Sub GarnirChamps()
Rem. Gérés par CL: CbxAppella: 2, CbxDomaine: 3, CbxMillésim: 4, CbxDsgnCru: 5, CbxRégion: 6, CbxConten: 7, CbxLaRobe: 8
Me.TBxMvtAchat = "": Me.TBxMvtRetrait = ""
If LCou > 0 Then
VLgn = CL.PlgTablo.Rows(LCou).Resize(, 19).Value
LabInfIdt = "Vin " & VLgn(1, 8) & " de " & VLgn(1, 4) & " en " & VLgn(1, 7)
Me.LabInfoCru = "Disponibilité : " & VLgn(1, 11) & " " & VLgn(1, 7) & IIf(VLgn(1, 11) > 1, _
"s d'une valeur totale de " & Format(VLgn(1, 19), "0.00 €"), "") & vbLf _
& "Remarque : " & IIf(VLgn(1, 10) > VLgn(1, 11), "Déjà été ouvert par le passé : " & VLgn(1, 10) - VLgn(1, 11), "Il n'en a jamais été ouverte.")
BtnValider.Caption = "Modifier"
Else
ReDim VLgn(1 To 1, 1 To 17)
Rem. LabInfIdt contient un texte fixé par CL_Change
Me.LabInfoCru = ""
BtnValider.Caption = "Ajouter"
End If
Me.TBxDateAchat = VLgn(1, 1)
Me.TBxPrix = Format(VLgn(1, 9), "0.00 €")
Me.TBxEntreStock = VLgn(1, 11)
Me.TBxNomVigneron = VLgn(1, 12)
Me.TBxAdresseVigneron = VLgn(1, 13)
If IsEmpty(VLgn(1, 14)) Then Me.TBxTelFixe = "" Else Me.TBxTelFixe = Format(VLgn(1, 14), "00"" ""00"" ""00"" ""00"" ""00")
If IsEmpty(VLgn(1, 15)) Then Me.TBxTelPort = "" Else Me.TBxTelPort = Format(VLgn(1, 15), "00"" ""00"" ""00"" ""00"" ""00")
Me.TBxMessagerie = VLgn(1, 16)
'Historique des achats
Me.LabTotalBoutAchat = WorksheetFunction.Sum(CL.PlgTablo.Columns(10))
Me.LabValeurTotalAchat = WorksheetFunction.Sum(CL.PlgTablo.Columns(18))
Me.LabValeurTotalAchat = Format(WorksheetFunction.Sum(CL.PlgTablo.Columns(18)), "0.00 €")
'Evolution du stock
Me.LabNombreStock = WorksheetFunction.Sum(CL.PlgTablo.Columns(11))
Me.LabValeurStock = WorksheetFunction.Sum(CL.PlgTablo.Columns(19))
Me.LabValeurStock = Format(WorksheetFunction.Sum(CL.PlgTablo.Columns(19)), "0.00 €")
End Sub
Private Sub BtnEffacer_Click()
CL.Nettoyer
End Sub
Private Sub BtnValider_Click()
Dim I As Long
If LCou = 0 Then
CL.PlgTablo.Rows(1).Copy
CL.PlgTablo.Rows(2).Insert
For I = 1 To CL.Count: With CL.Item(I): VLgn(1, .Col) = .CBx.Text: End With: Next I
LCou = 1: End If
VLgn(1, 1) = Me.TBxDateAchat
VLgn(1, 9) = CCur(Me.TBxPrix)
VLgn(1, 10) = Me.TBxNbrBouteille
VLgn(1, 11) = Me.TBxEntreStock
VLgn(1, 12) = Me.TBxNomVigneron
VLgn(1, 13) = Me.TBxAdresseVigneron
VLgn(1, 14) = Empty: If IsNumeric(Me.TBxTelFixe) Then VLgn(1, 14) = CDbl(Me.TBxTelFixe)
VLgn(1, 15) = Empty: If IsNumeric(Me.TBxTelPort) Then VLgn(1, 15) = CDbl(Me.TBxTelPort)
VLgn(1, 16) = Me.TBxMessagerie
CL.PlgTablo.Rows(LCou).Resize(, 17).Value2 = VLgn
CL.Actualiser
GarnirChamps
End Sub
Private Sub BtnRetirer1_Click()
VLgn(1, 11) = VLgn(1, 11) - 1
CL.PlgTablo.Cells(LCou, 11) = VLgn(1, 11)
GarnirChamps
End Sub
Private Sub BtnSupprimer_Click()
CL.PlgTablo.Rows(LCou).Delete
CL.Actualiser
End Sub
