XL 2010 Ranger différentes valeurs dans une cellule

Eric C

XLDnaute Barbatruc
Bonjour à toutes & à tous

Soit un USF comprenant 7 TextBoxs avec des valeurs monétaires, précédés de 7 Labels renfermant la correspondance des montants saisis.
Sans titre2.png

Mon objectif : Ranger à la suite, différentes valeurs alphabétiques et numériques dans une cellule sans écraser celles déjà présentes.

Détail : Boucler sur les valeurs des TextBoxs.
. Si la valeur du TextBox est <> de 0, placer dans la cellule A1, le caption (du label) suivi du symbole "=" puis de la valeur du TextBox et enfin d'un séparateur ";" et ce jusqu'au dernier TextBox concerné, comme dans l'exemple ci après :
Sans titre.png

J'ai essayé individuellement pour chaque TextBox dès leur sortie en faisant :


VB:
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If TextBox1.Value <> 0 Then
[A1] = Label1.Caption & "=" & TextBox1.Value
End If
End Sub
                     
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If TextBox2.Value <> 0 Then
[A1] = ";" & Label2.Caption & "=" & TextBox2.Value
End If
End Sub
mais la valeur présente dans la cellule est écrasée par la nouvelle venue.

Détail : C'est lors de la procédure de sortie du TextBox6 que devra se produire la boucle :


Code:
Private Sub TextBox6_Exit(ByVal Cancel As MSForms.ReturnBoolean)
TextBox7 = Val(TextBox1) + Val(TextBox2) + Val(TextBox3) + Val(TextBox4) + Val(TextBox5) + Val(TextBox6)

For i = 1 to 3
 If Me.Controls("TextBox" & i) <> 0  Then
...
Next i
End Sub

Merci de l'attention que vous voudrez porter à ce post -
En espérant avoir été assez clair ???

Bon ouikand à toutes & à tous
@+ Eric c
 

Pièces jointes

  • ClasseurEssai.xlsm
    24.1 KB · Affichages: 5
Solution
Bonjour @Eric C

VB:
Option Explicit
Public Sub CommandButton1_Click()
Dim Ctrl As Control
Dim Res As Double
    For Each Ctrl In Me.Controls
        If TypeOf Ctrl Is MSForms.TextBox And Ctrl.Name <> "TextBox4" Then
            Res = Res + Format(CDbl(Ctrl.Text), "##,###,##0.00")
        End If
    Next Ctrl
 TextBox4.Text = Format(Res, "##,###,##0.00") & " €"
 Res = Empty
 If Not IsNumeric(TextBox4.Text) Then Exit Sub
 [A1].Offset(, 1) = TextBox4.Value
  Me.Hide
End Sub
Public Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If TextBox1.Value <> 0 Then
    If [A1] = Empty Then
        [A1] = Label1.Caption & "=" & Format(TextBox1.Value, "##,###,##0.00") & " €"
    Else
        [A1] = [A1] & "; " & Label1.Caption & "=" &...

laurent950

XLDnaute Barbatruc
Bonjour @Eric C

VB:
Option Explicit
Public Sub CommandButton1_Click()
Dim Ctrl As Control
Dim Res As Double
    For Each Ctrl In Me.Controls
        If TypeOf Ctrl Is MSForms.TextBox And Ctrl.Name <> "TextBox4" Then
            Res = Res + Format(CDbl(Ctrl.Text), "##,###,##0.00")
        End If
    Next Ctrl
 TextBox4.Text = Format(Res, "##,###,##0.00") & " €"
 Res = Empty
 If Not IsNumeric(TextBox4.Text) Then Exit Sub
 [A1].Offset(, 1) = TextBox4.Value
  Me.Hide
End Sub
Public Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If TextBox1.Value <> 0 Then
    If [A1] = Empty Then
        [A1] = Label1.Caption & "=" & Format(TextBox1.Value, "##,###,##0.00") & " €"
    Else
        [A1] = [A1] & "; " & Label1.Caption & "=" & Format(TextBox1.Value, "##,###,##0.00") & " €"
    End If
    TextBox1.Value = Format(TextBox1.Value, "##,###,##0.00") & " €"
End If
End Sub
Public Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If TextBox2.Value <> 0 Then
    If [A1] = Empty Then
        [A1] = Label2.Caption & "=" & Format(TextBox2.Value, "##,###,##0.00") & " €"
    Else
        [A1] = [A1] & "; " & Label2.Caption & "=" & Format(TextBox2.Value, "##,###,##0.00") & " €"
    End If
    TextBox2.Value = Format(TextBox2.Value, "##,###,##0.00") & " €"
End If
End Sub
Public Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If TextBox3.Value <> 0 Then
    If [A1] = Empty Then
        [A1] = Label3.Caption & "=" & Format(TextBox3.Value, "##,###,##0.00") & " €"
    Else
        [A1] = [A1] & "; " & Label3.Caption & "=" & Format(TextBox3.Value, "##,###,##0.00") & " €"
    End If
    TextBox3.Value = Format(TextBox3.Value, "##,###,##0.00") & " €"
End If
End Sub
Private Sub UserForm_Activate()
Dim i As Byte
    For i = 1 To 4
      Me.Controls("TextBox" & i) = ""
    Next i
End Sub
 

Eric C

XLDnaute Barbatruc
Bonjour le forum
Bonjour Laurent

Waouhhhh !! Du grand art. J'ai survolé (je dois m'absenter) mais j'ai pris le temps de regarder et de lancer la procédure. Je n'ai plus qu'à faire la somme en Txt4 et passer les séparateurs en ".". Bravo l'artiste. Je reviens dès mon retour.
Grand Merci à toi.
Bonne fin d'après-midi
@+ Eric c
 

Eric C

XLDnaute Barbatruc
Re.

Je viens de rentrer, j'ai modifié les formats pour entrée au pavé(".") et finalisé le TextBox Total. Ca fonctionne super bien - Bon & beau travail. Si j'ai un petit soucis (je vais retranscrire tout cela dans le fichier d'hier avec mémorisation de la cellule cliquée....), je peux repasser sur ce post ?

Bonne soirée et encore merci
@+ Eric c
 

Eric C

XLDnaute Barbatruc
Bonjour le fil
Bonjour Laurent

J'ai fusionné ton code avec celui de Yeahou. J'ai peu être un peu trop bidouillé car hier ce qui marchait ne fonctionne plus ce jour ?? Dans le fichier joint, je ne me sers que des 3 premiers TextBoxs pour mes essais et du 4ème pour le total qui est porté en cellule N (cliquée) + 1.
Les problèmes rencontrés :
Res = Res + Format(CDbl(Ctrl.Text), "# ##0.00 ") Erreur 13 – Incompatibilité de type

En debbogage, j'ai bien le résultat Res=27,31 - Pour mes tests j'indique dans les 3 TextBoxs, les valeurs suivantes : (TB1 = 0,54 – TB2 = 14,22 – TB3 = 12,55) -
-=-=-=-=-=-=-

Au départ, je parvenais à saisir des valeurs avec le "." du pavé numérique mais cela ne fonctionne plus ???
-=-=-=-=-

Le résultat dans TextBox4 est tronqué (valeur inférieure sans décimale 26 au lieu de 27,31 ? )

Je vais poursuivre demain. Merci à toi.
Bonne nuit
Eric
 

Pièces jointes

  • Fichier facturation -Pour Laurent.xlsm
    31.8 KB · Affichages: 2

Eric C

XLDnaute Barbatruc
Bonjour le forum
Bonjour Laurent

La nuit porte conseil. J'ai résolu tous les petits problèmes mais j'aimerais, si tu le veux bien et si tu as le temps, de corriger le problème de Res (après lecture et relecture, j'ai déduit que Res était le résultat de tous les TextBoxs ? - Le problème est que cela ne fonctionne pas sur ce fichier. Je ne parviens pas, non plus, à me servir de la touche "." du pavé numérique.
Sinon, tel qu'il a été revu, tout fonctionne pil poil.
La cerise sur le gâteau : y a t'il possibilité de simplifier le code des TextBoxs car là il y en a 7 et je trouve que cela fait beaucoup de lignes répétitives.

Bonne journée à toutes & à tous.
@+ Eric c
 

Pièces jointes

  • Fichier facturation -Pour Laurent.xlsm
    32 KB · Affichages: 4
Dernière édition:

laurent950

XLDnaute Barbatruc
Bonsoir @Eric C
La cerise sur le gâteau : y a t'il possibilité de simplifier le code des TextBoxs car là il y en a 7 et je trouve que cela fait beaucoup de lignes répétitives.

Il faudrait passer par un module de classe associer avec une variable Objet collection.
J'ai des idées mais il faut tous mette en place et bien sur commenter mais pas simple quand même

Je vais regarder cela
 

Eric C

XLDnaute Barbatruc
Je te remercie pour ta sollicitude Je n'ai pas assez de bases solides pour aborder certains sujets et ne suis pas assez assidu (trop de projets divers à la maison en cours... Pas bien).
Oui, sur le forum, il y a les très bons (dont tu fais partie) et les excellent. Parmi ceux là, il y en a un qui me boude et qui ne "survole" même pas mes posts, c'est dommage et c'est vrai qu'il y a Dranreb qui est fort pointu dans son domaine (je n'arrive pas à le suivre dans ses démarches...Lol) .
Bon courage et saches que tu as le temps, je désire simplement savoir de quelle façon simplifier l'utilisation répétitive de tous les codes identiques.
Encore merci -
Bonne soirée
Eric
 
Dernière édition:

laurent950

XLDnaute Barbatruc
Re

@Dranreb à publié la solution que j'essaie d'adapter mais pas si simple.

Quelques choses comme ca : (Avec Votre Fichier en Poste #6)

UserForm1 : Le Code
VB:
Option Explicit
Public TDon As Variant
Private myEventHandlers As Collection
Dim RubGlobale As New SupportTBx

Private Sub UserForm_Initialize()
    TDon = Array("TextBox1", "TextBox2", "TextBox3")
    Dim SsRub As SupportTBx
    Set myEventHandlers = New Collection
    Dim c As Control
    For Each c In Me.Controls
        If TypeName(c) = "TextBox" Then
            Set SsRub = RubGlobale.Item(c)
            myEventHandlers.Add RubGlobale
        End If
    Next c
End Sub

Puis créer un Module de Classe :
Le nom qu'il faut donner au Module de Classe : SupportTBx
Le code du Module de Classe
Code:
Option Explicit
Private WithEvents TBx As MSForms.TextBox
Private Res As Double
Private CLn As Collection
Private Sub Class_Initialize()
   Set CLn = New Collection
   End Sub
Public Function Item(ByVal TxtBox As MSForms.TextBox) As SupportTBx
   On Error Resume Next
   Set Item = CLn(TxtBox.Name)
   If Err Then
      Set Item = New SupportTBx
      Set TBx = TxtBox
      CLn.Add Item, TxtBox.Name
   End If
   End Function

Private Sub TBx_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    MsgBox "OK suite double clique TexteBox"
    ' Ici la condition avec le nom dans la Variable Objet Collection Cln
    ' exemple :
    ' dim TxtBox as SupportTBx
    ' set TxtBox = CLn(TBx.name)
    ' le texbox suit avec tous le contenue de la classe
    ' Dim i as Byte
    ' For i = Lbound(TDon) to Ubound(TDon)
    ' if TBx.name = TDon(i) then
    '    UserForm1.TextBox4.Text = UserForm1.TextBox4.Text + Tbx.text
    ' Elseif TBx.name = UserForm1.TextBox4.Name then
    '     Tbx.text = TxtBox.Res
    ' End if
    ' Next i
End Sub

Private Sub TBx_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If TBx.SelStart = 0 Then
        KeyAscii = AscW(UCase$(ChrW$(KeyAscii)))
    End If
   End Sub
Property Let Resultat(ByVal Sum As Double)
    Res = Sum
End Property
Property Get Resultat()
    Resultat = Res
End Property

Mais j'arrive pas a connecter l'évènement avec un click, double click ou change. même avec le code ajouter de Dranreb
 

laurent950

XLDnaute Barbatruc
Re @Dranreb

Code UserForm1
VB:
Option Explicit
Private Cln As New Collection
Private Sub UserForm_Initialize()
    Dim SBx As SupportTBx
    Dim c As Control
    For Each c In Me.Controls
        If TypeName(c) = "TextBox" Then
            Set SBx = New SupportTBx
            SBx.Init c
            Cln.Add SBx
        End If
    Next c
End Sub

Code Module de Classe : Nom SupportTBx
Code
Code:
Option Explicit
Private WithEvents TBx As MSForms.TextBox
Private TDon As Variant
Private Res As Double
Private Sub Class_Initialize()
    TDon = Array("TextBox1", "TextBox2", "TextBox3")
End Sub
Public Sub Init(ByVal TxtBox As MSForms.TextBox)
   Set TBx = TxtBox
   End Sub
Private Sub TBx_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
     Dim i As Byte
     For i = LBound(TDon) To UBound(TDon)
     If TBx.Name = TDon(i) Then
        UserForm1.TextBox4.Text = UserForm1.TextBox4.Text + TBx.Text
     ElseIf TBx.Name = UserForm1.TextBox4.Name Then
         TBx.Text = UserForm1.TextBox4.Text
     End If
     Next i
End Sub
 

Eric C

XLDnaute Barbatruc
Bonsoir Laurent, bonsoir Dranreb

Non, je pense que je vais rester sur le fichier du Post#6. Après tout, il n'y a que 6 TextBoxs à renseigner. J'ai repris le fichier de Dranreb du post #11 et suis parvenu à faire un fichier avec 4 TextBoxs qui, lorsque l'on les double clique, affichent la date du jour, donc ça fonctionne (c'est un début).
Dans mon cas, le code doit prélever ET des valeurs de TextBoxs ET des captions de Labels... Cela fait beaucoup et je ne me sens pas à l'aise (je retenterai mais au matin).

Encore merci et bonne nuit.
@+ Eric c
 

Discussions similaires

Statistiques des forums

Discussions
315 047
Messages
2 115 698
Membres
112 555
dernier inscrit
Sandy1710