Microsoft 365 Calcul TEXTBOX dans Userform

eric72

XLDnaute Accro
Bonjour,
Je cherche à faire des calculs de Textbox dans un Userform en sachant qu'elles ne sont pas toujours toutes renseignées à chaque fois, malgré cela j'aimerais que le calcul se fasse quand même en tenant compte de celles renseignées, donc j'ai adapté ce code mais ça ne va pas.
Ou est la boulette?
Merci à tous
 

Pièces jointes

  • Gestion Fiche Produit test.xlsm
    204 KB · Affichages: 31

eric72

XLDnaute Accro
Oui aussi mais j'avais peur que cela ne pose problème après lorsque l'on change le coeff, et puis l'avantage comme j'ai fait c'est que cela est transparent dans l'usf.
Je sais que je t'agace un peu quelque fois mais tu ne lâches jamais rien, c'est ta 1ère qualité, tu dois être un sacré personnage dans la vie.
Merci beaucoup pour ta patience, sujet résolu!!!
Eric
 

patricktoulon

XLDnaute Barbatruc
re
je suis un vieux con de première oui 😂
et avec ce purée de covid de M!... qui m'a bouffé la vie depuis 1 semaine et demie je te dis pas
j’émerge a peine
ca + mon caractère ben tu vois le résultat faut pas faire ch... l'ours quoi 😁

je mémorise la modif dans la version 4.0 au cas ou tu planterais tout 😁
VB:
'*********************************************************************
'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
 
Dernière édition:

Etoto

XLDnaute Barbatruc
Quoi qu'il arrive tu es un mec génial!!!
Et ça n'a pas de prix.
Si tu as des petits enfants ils peuvent être fiers du Papy.
Bonjour Etoto.
Bonne journée a vous deux et reposes toi Patrick ça ne rigole pas la santé.
En tout cas, une chose est sure, tu es un demandeur reconnaissant et merci de l'être, bonjour à toi aussi, j'ai oublié de te saluer, quelle impoli je fait ! ;)
 

patricktoulon

XLDnaute Barbatruc
puré oui 11 bien passées même
il en a vu cet userforms et les autres d'ailleurs car je n'ai pas fait que celui là pour ERic
le plus difficile n'est pas vraiment le vba employé
le plus difficile est de comprendre la demande dans sa globalité après la mise en route n'est rien
@Etoto si tu relis le post du début tu verra que l'on est parti de loin
c'est vrai dans certains domaines du vba je suis comme un poisson dans l'eau , c'est pas le cas de tout le monde j'ai tendance a manquer de patience ce qui est pourtant une particularité essentiel dans une de mes activités
 

Discussions similaires

Réponses
10
Affichages
315

Statistiques des forums

Discussions
311 720
Messages
2 081 910
Membres
101 837
dernier inscrit
Ugo