'*********************************************************************
'Module classe pour le userform <<UsfProduit>>
'gestion des textboxs en numerique forcé et monetaire
'product By patricktoulon on exceldownloads for @Eric72
' date:28/10/2021
'mises a jour
'date:29/10/2021; effacement automatique quand on efface la donnée dans les textbox <<PR.....>>
'date:30/10/2021; ajout du renvoie a la sub calculette a chaque changement par GotoCalcul( a chaque calcul PR)
' netoyage balisage et simplification du code
'
'date 13/01/2022; ajout de l'interception v(1) & v(3) si =0 pour le calcul sur PRPlante
'*********************************************************************
Option Explicit
Public WithEvents txtB As MSForms.TextBox
Public WithEvents PXv As MSForms.TextBox
Dim mesclasses() As New mestextboxfram
Public tous
Public UsF As Object
Public mamanFram
Public Tout_les_Noms
Function init_Classing(uf)
Dim a&, e&, txt, t1(1 To 20) As Object, t2(1 To 20) As String, ctr As Object, z&, Fram, x
For Each Fram In uf.Controls
e = 0: x = 0
If TypeName(Fram) = "Frame" Then
For Each txt In Fram.Controls
If txt.Tag = "x" Then
a = a + 1: ReDim Preserve mesclasses(1 To a)
e = e + 1: Set t1(e) = txt: t2(e) = txt.Name & " ":
With mesclasses(a)
Set .txtB = txt: Set .UsF = uf: Set .mamanFram = Fram
End With
End If
Next
End If
'subclassing de la serie dans toute les instances concernées
For z = a To a - (e - 1) Step -1: With mesclasses(z): .tous = t1: .Tout_les_Noms = t2: End With: Next
Next
'on ajoute prixdevente tout seul pour la gestion du keypress seulement
Set PXv = uf.PrixVente
End Function
Private Sub txtB_Change()
'la variable "tous" contient les object textbox de leur frame respective
Dim critere As Boolean, V, q&
With mamanFram
Select Case .Name
Case "FrPlante":
V = Array(.PrixAchatPlante.Value, .CoeffPlante.Value, .PrixAchatPlante.Value, .TransPlante.Value)
critere = V(0) <> "" And V(2) <> "" 'And V(3) <> ""supression du test vide pour transplante
If .TransPlante = "" Then V(3) = 0
If .CoeffPlante = "" Then V(1) = 1
If critere Then .PRPlante.Value = Format((CDbl(V(0)) * CDbl(V(1))) + (CDbl(V(2)) * CDbl(V(3))), "#0.00 €"): GotoCalcul Else .PRPlante.Value = ""
Case "FrCdt":
V = Array(.PrixCdt.Value, .TxtSoie.Value, .TxtCordelette.Value, .TxtEtiquetteCarton.Value, .CoeffCdt.Value)
For q = 0 To UBound(V)
If V(q) = "" Then V(q) = 0 Else critere = True
Next
If critere Then .PRCdt = Format((CDbl(V(0)) + CDbl(V(1)) + CDbl(V(2)) + CDbl(V(3))) * CDbl(V(4)), "#0.00 €"): GotoCalcul Else .PRCdt = ""
Case "FrPot":
V = Array(.PrixPot.Value, .CoeffPot.Value)
critere = V(0) <> "" And V(1) <> ""
If critere Then .PRPot.Value = Format((CDbl(V(0)) * CDbl(V(1))), "#0.00 €"): GotoCalcul Else .PRPot = ""
Case "FrPlaque":
V = Array(.PrixPlaque.Value, .CoeffPlaque.Value, .NbPlantePlaque.Value)
critere = V(0) <> "" And V(1) <> "" And V(2) <> ""
If critere Then .PRPlaque = Format((CDbl(V(0)) * CDbl(V(1))) / CDbl(V(2)), "#0.00 €"): GotoCalcul Else .PRPlaque = ""
Case "FrChromo":
If .PrixChromo.Value <> "" Then .PRChromo.Value = Format(.PrixChromo.Value, "#0.00 €"): GotoCalcul Else .PrixChromo = ""
Case "FrEtiquette":
.PREtiquette.Value = Format(.PrixEtiquette.Value, "#0.00 €"): GotoCalcul
Case "FrEntourage":
If .PrixEntourage.Value <> "" Then .PREntourage.Value = Format(.PrixEntourage.Value, "#0.00 €"): GotoCalcul Else .PrixEntourage
Case "FrEmballage":
V = Array(.Mousseline.Value, .Kraft.Value, .DsSmith.Value)
For q = 0 To UBound(V)
If V(q) = "" Then V(q) = 0 Else critere = True
Next
If critere Then .PREmballage = Format((CDbl(V(0)) + CDbl(V(1)) + CDbl(V(2))), "#0.00 €"): GotoCalcul Else .PREmballage = ""
Case "FrAccess":
V = Array(.TxtPrixAccessoire.Value, .TxtCoeffAccess.Value)
critere = V(0) <> "" And V(1) <> ""
If critere Then .PRAccess.Value = Format((CDbl(V(0)) * CDbl(V(1))), "#0.00 €"): GotoCalcul Else .PRAccess.Value = ""
Case "FrMO":
V = Array(.TxtCoutHrMO.Value, .TxtTempsMO.Value)
critere = V(0) <> "" And V(1) <> ""
If critere Then .TxtPrMO.Value = Format((CDbl(V(0)) * CDbl(V(1))), "#0.00 €"): GotoCalcul Else .TxtPrMO.Value = ""
Case "FrTransport"
V = Array(.PoidsPlante.Value, .PrixKgPlante.Value)
critere = V(0) <> "" And V(1) <> ""
If critere Then .PRTransport.Value = (CDbl(V(0)) * CDbl(V(1))): GotoCalcul Else .PRTransport.Value = ""
End Select
End With
'UsF.PrixVente = "": UsF.Marge = ""
End Sub
Public Sub TxtB_KeyPress(ByVal keyascii As MSForms.ReturnInteger)
'le vrai code ET au complet !!!!!! de patricktoulon
Dim ctrl As Object
Set ctrl = UsF.ActiveControl: Do While TypeName(ctrl) <> "TextBox": Set ctrl = ctrl.ActiveControl: Loop
With ctrl
If keyascii = 46 Then keyascii = 44
If Chr(keyascii) Like "[!0-9|,-]" Then keyascii = 0
If (Len(.Value) = 0 Or .Value Like "*,*") And Chr(keyascii) = "," Then keyascii = 0
If Chr(keyascii) = "-" And .Value <> "" Then keyascii = 0
End With
End Sub
Public Sub pxv_KeyPress(ByVal keyascii As MSForms.ReturnInteger)
'le vrai code ET au complet !!!!!! de patricktoulon
Dim ctrl As Object
With PXv
If keyascii = 46 Then keyascii = 44
If Chr(keyascii) Like "[!0-9|,-]" Then keyascii = 0
If (Len(.Value) = 0 Or .Value Like "*,*") And Chr(keyascii) = "," Then keyascii = 0
If Chr(keyascii) = "-" And .Value <> "" Then keyascii = 0
End With
End Sub
Public Sub GotoCalcul()
'la sub gotocalcul renvoie le calcul dans la sub calculette dans l'userform
UsfProduit.calculette
Exit Sub
End Sub