Class Module & KeyDown

[Magic_Doctor]

Hello,

On the sheet there are several TextBoxes: "TextBoxPP1", "TextBoxPP2" ...
Each TextBox has its own procedure in the sheet module:

Private Sub TextBoxPP1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

Dim x As Byte, obj1 As Object, obj2 As Object, obj3 As Object, i As Byte, pourcent, ad

    x = 1
    Set obj1 = ActiveSheet.OLEObjects("TextBoxPP" & x).Object
    Set obj2 = ActiveSheet.OLEObjects("CheckBoxPP" & x).Object
    Set obj3 = ActiveSheet.OLEObjects("TextBox_AddPourcent").Object

    With obj1
        If KeyCode = 110 Then
            .Value = .Value & ","
            KeyCode = 0
            Exit Sub
        ElseIf KeyCode = vbKeyClear Or KeyCode = vbKeyDelete Then
            .Value = 0
            .Value = Format(CDbl(obj1.Value), "##,##0.00""%""")
            KeyCode = 0
            obj2 = 0
            CheckSolvants = CheckSolvants - 1
            pourcents(x) = 0
        End If
        If KeyCode = 13 Then
            With obj1
                If Not IsNumeric(.Value) Then
                    .Value = 0
                    .Value = Format(CDbl(obj1.Value), "##,##0.00""%""")
                    obj2 = 0
                    CheckSolvants = CheckSolvants - 1
                    pourcents(x) = 0
                    Exit Sub
                End If
                .Value = Replace(.Value, ".", ",")
                If CDbl(.Value) > 0 Then
                    pourcent = CDbl(obj1.Value)
                    pourcents(x) = pourcent
                    .Value = Format(CDbl(obj1.Value), "##,##0.00""%""")
                Else
                    .Value = 0
                    .Value = Format(CDbl(obj1.Value), "##,##0.00""%""")
                    obj2 = 0
                    CheckSolvants = CheckSolvants - 1
                    pourcents(x) = 0
                End If
            End With
            [A1].Select
        End If
        For i = 1 To NbSolvants + 1  '(Base 0)
            Set obj1 = ActiveSheet.OLEObjects("TextBoxPP" & i).Object
            ad = ad + pourcents(i)
        Next
        If ad > 100 Then
            pourcent = 100 - ad + pourcent
            pourcents(x) = pourcent
            Set obj1 = ActiveSheet.OLEObjects("TextBoxPP" & x).Object
            obj1.Value = pourcent
            obj1.Value = Format(CDbl(obj1.Value), "##,##0.00""%""")
        End If
        
        ad = 0
        For i = 1 To NbSolvants + 1  '(Base 0)
            Set obj2 = ActiveSheet.OLEObjects("CheckBoxPP" & i).Object
            If obj2 = -1 Then ad = ad + pourcents(i)
        Next
        obj3.Value = Format(ad, "##,##0.00""%""")
    End With
End Sub

The procedures are identical for all TextBoxes, the only difference is the value of the variable x at the start of the procedure: x = 1 for the TextBox "TextBoxPP1", x = 2 for the TextBox "TextBoxPP2" ...
I report that everything is working very well. The problem is, there are 20 TextBoxes ("TextBoxPP1" to "TextBoxPP20"), and since each procedure is relatively long, it's a never-ending story ... Also, I would like to handle all of these TextBox by means of a class module.
I started the work by writing:
1 / in "ThisWorkbook":

Option Explicit
Dim TXB() As New Classe_ActiveX

Sub Workbook_Open()
    With Worksheets("Données")
        For Each obj In .OLEObjects
            If TypeName(obj.Object) = "TextBox" And ExtractText(obj.Name) = "TextBoxPP" Then
                ReDim Preserve TXB(n)
                Set TXB(n).TXB = obj.Object
                n = n + 1
            End If
        Next
    End With
End Sub

2 / in the class module that I called "Class_ActiveX":

Option Explicit
Public WithEvents TXB As MSForms.TextBox

            and there I do not know how to do ...

I am unable to terminate my application due to "TXB_KeyDown". If it was "TXB_Change", that wouldn't be a problem.
Thanks in advance for helping me solve this problem.

 

[GWteB]

See if this works for you ...

This goes in a Class module, to be renamed clsTextboxEvents:

Option Explicit

' Class clsTextboxEvents

Private WithEvents TbxGroup  As MSForms.TextBox

Private Type TTextBoxProps
    Name        As String
    HostSheet   As Worksheet
End Type
Private this As TTextBoxProps

Friend Sub Create(ByVal argTBox As MSForms.TextBox, ByVal argSht As Worksheet, ByVal argTbxName As String)
    Set TbxGroup = argTBox
    Set this.HostSheet = argSht
    this.Name = argTbxName
End Sub

Private Sub TbxGroup_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    OnKeyDown KeyCode, Shift
End Sub


' =======  your original code with some minor adjustments ==========

Private Sub OnKeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

    Dim x As Long, obj1 As Object, obj2 As Object, obj3 As Object, i As Long, pourcent, ad

    ' >> if TextBox_AddPourcent then jump to corresponding End If <<
    If StrComp(this.Name, "TextBox_AddPourcent", vbTextCompare) <> 0 Then

        x = Val(VBA.Replace(this.Name, "TextBoxPP", ""))

        Dim RelatedChkBoxName As String
        RelatedChkBoxName = VBA.Replace(this.Name, "Text", "Check")
        Set obj2 = this.HostSheet.OLEObjects(RelatedChkBoxName).Object
        Set obj3 = this.HostSheet.OLEObjects("TextBox_AddPourcent").Object

        With TbxGroup
            
            If KeyCode = 110 Then
                .Value = .Value & ","
                KeyCode = 0
                Exit Sub
            ElseIf KeyCode = vbKeyClear Or KeyCode = vbKeyDelete Then
                .Value = 0
                .Value = Format(CDbl(.Value), "##,##0.00""%""")
                KeyCode = 0
                obj2 = 0
                CheckSolvants = CheckSolvants - 1
                pourcents(x) = 0
            End If
            
            If KeyCode = 13 Then
                If Not IsNumeric(.Value) Then
                    .Value = 0
                    .Value = Format(CDbl(.Value), "##,##0.00""%""")
                    obj2 = 0
                    CheckSolvants = CheckSolvants - 1
                    pourcents(x) = 0
                    Exit Sub
                End If
                .Value = Replace(.Value, ".", ",")
                If CDbl(.Value) > 0 Then
                    pourcent = CDbl(.Value)
                    pourcents(x) = pourcent
                    .Value = Format(CDbl(.Value), "##,##0.00""%""")
                Else
                    .Value = 0
                    .Value = Format(CDbl(.Value), "##,##0.00""%""")
                    obj2 = 0
                    CheckSolvants = CheckSolvants - 1
                    pourcents(x) = 0
                End If
                [A1].Select
            End If
            
            For i = 1 To NbSolvants + 1          '(Base 0)
                Set obj1 = ActiveSheet.OLEObjects("TextBoxPP" & i).Object
                ad = ad + pourcents(i)
            Next
            
            If ad > 100 Then
                pourcent = 100 - ad + pourcent
                pourcents(x) = pourcent
'                Set obj1 = ActiveSheet.OLEObjects("TextBoxPP" & x).Object
'                obj1.Value = pourcent
'                obj1.Value = Format(CDbl(obj1.Value), "##,##0.00""%""")
                .Value = pourcent
                .Value = Format(CDbl(obj1.Value), "##,##0.00""%""")
            End If
        
            ad = 0
            For i = 1 To NbSolvants + 1          '(Base 0)
                Set obj2 = ActiveSheet.OLEObjects("CheckBoxPP" & i).Object
                If obj2 = -1 Then ad = ad + pourcents(i)
            Next
            obj3.Value = Format(ad, "##,##0.00""%""")
        End With
    End If
End Sub

This goes in the ThisWorkbook module:

Option Explicit

Private Type TTWbkStorage
    Coll As Collection
End Type
Private this As TTWbkStorage

Private Sub Workbook_Open()
    Call ExposeTextBoxEvents
End Sub


Private Sub ExposeTextBoxEvents()

    Dim clsTbx  As clsTextboxEvents
    Dim oWs     As Worksheet
    Dim oCtl    As Object
    
    Set this.Coll = New Collection
    For Each oWs In ThisWorkbook.Sheets
        For Each oCtl In oWs.OLEObjects
            If oCtl.progID = "Forms.TextBox.1" Then
                Set clsTbx = New clsTextboxEvents
                clsTbx.Create argTBox:=oCtl.Object, argSht:=oWs, argTbxName:=oCtl.Name
                this.Coll.Add clsTbx
            End If
        Next oCtl
    Next oWs
End Sub

 

[Magic_Doctor]

Hello GWteB,

It works very well, even if I did not understand everything ...
I took a good look at your corrections.
When you correct this:

            For i = 1 To NbSolvants + 1                                 
                Set obj1 = ActiveSheet.OLEObjects("TextBoxPP" & i).Object
                ad = ad + pourcents(i)
            Next
            If ad > 100 Then                                             
                pourcent = 100 - ad + pourcent                           
                pourcents(x) = pourcent                                 
              
'                Set obj1 = ActiveSheet.OLEObjects("TextBoxPP" & x).Object
'                obj1.Value = pourcent                                   
'                obj1.Value = Format(CDbl(obj1.Value), "##,##0.00""%""") 

                .Value = pourcent                                       
                .Value = Format(CDbl(obj1.Value), "##,##0.00""%""")     
            End If

looking closely, it makes perfect sense to me.
Strangely enough, when I put a value (a percentage) that exceeds the maximum value it can have (the sum of all the percentages is then > 100), there is a bug.
So I had to be forced to put this:

            For i = 1 To NbSolvants + 1                                 
                Set obj1 = ActiveSheet.OLEObjects("TextBoxPP" & i).Object
                ad = ad + pourcents(i)
            Next
            If ad > 100 Then                                             
                pourcent = 100 - ad + pourcent                           
                pourcents(x) = pourcent                                 
              
                Set obj1 = ActiveSheet.OLEObjects("TextBoxPP" & x).Object
                obj1.Value = pourcent                                   
                obj1.Value = Format(CDbl(obj1.Value), "##,##0.00""%""") 

'                .Value = pourcent                                       
'                .Value = Format(CDbl(obj1.Value), "##,##0.00""%""")     
            End If

and I did not quite understand why.
Anyway, a big thank you for your help, without which I never would have done it.

 

[GWteB]

You are welcome.

Strangely enough, when I put a value (a percentage) that exceeds the maximum value it can have (the sum of all the percentages is then > 100), there is a bug.

I forgot to make one correction. I'll explain what's going on.
In your original code you used the variable obj1 for multiple objects. In these three lines of code, the current text box was reassigned to variable obj1. This is no longer necessary in the current setup, because the variable TbxGroup refers to the current text box.
If you adjust the code according to the image you're good. Note that the dot in front of Value needs to be there, so it should look like:

.Value = Format(CDbl(.Value), "##,##0.00""%""")

 

[Magic_Doctor]

Thank you for your patience,
Unfortunately, if I withdraw the last 2 sentences and then enter a percentage which causes the sum of all the percentages to exceed 100%, the excess number entered is accepted and is not automatically corrected. It is very curious.
An example. Suppose there are only 3 TextBoxes. In the first there is 25%, in the second 50%. Normally, if I enter an incorrect number like 30% in the third TextBox, automatically the number that will be displayed will not be 30% but 25%.

 

[GWteB]

Unfortunately, if I withdraw the last 2 sentences

You weren't supposed to leave them both out entirely, you were supposed to modify the lower of the two following the instructions I gave.
So this snippet...

                .Value = pourcent                                       
                .Value = Format(CDbl(obj1.Value), "##,##0.00""%""")

should have been amended in this way:

                .Value = pourcent                                       
                .Value = Format(CDbl(.Value), "##,##0.00""%""")

 

[Magic_Doctor]

Hello,

Yes! Now it works.
I even made a small simplfication by writing directly:

.Value = Format(pourcent, "##,##0.00""%""")

Once again thank you!

 

[GWteB]

You are welcome.

I even made a small simplfication by writing directly:

I had seen it, but didn't want to undermine your original code to much ...
Well done!!

 

[Magic_Doctor]

Which gives, after purifications of the heaviness on my part:

Private Sub OnKeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

    Dim x As Byte, RelatedChkBoxName$, obj As Object, i As Byte, pourcent#, ad#

    ' >> if TextBox_AddPourcent then jump to corresponding End If <<
    If StrComp(this.Name, "TextBox_AddPourcent", vbTextCompare) <> 0 Then

        x = Val(VBA.Replace(this.Name, "TextBoxPP", ""))

        With TbxGroup
            RelatedChkBoxName = VBA.Replace(this.Name, "Text", "Check")
            Set obj = this.HostSheet.OLEObjects(RelatedChkBoxName).Object
            If KeyCode = 110 Then
                .Value = .Value & ","
                KeyCode = 0
                Exit Sub
            ElseIf KeyCode = vbKeyClear Or KeyCode = vbKeyDelete Then
                .Value = Format(0, "##,##0.00""%""")
                KeyCode = 0
                obj = 0
                CheckSolvants = CheckSolvants - 1
                pourcents(x) = 0
            End If
            If KeyCode = 13 Then
                If Not IsNumeric(.Value) Then
                    .Value = Format(0, "##,##0.00""%""")
                    obj = 0
                    CheckSolvants = CheckSolvants - 1
                    pourcents(x) = 0
                    Exit Sub
                End If
                .Value = Replace(.Value, ".", ",")
                If CDbl(.Value) > 0 Then
                    pourcent = CDbl(.Value)
                    pourcents(x) = pourcent
                    .Value = Format(pourcent, "##,##0.00""%""")
                Else
                    .Value = Format(0, "##,##0.00""%""")
                    obj = 0
                    CheckSolvants = CheckSolvants - 1
                    pourcents(x) = 0
                End If
                [A1].Select
            End If
            For i = 1 To NbSolvants + 1
                ad = ad + pourcents(i)
            Next
            If ad > 100 Then
                pourcent = 100 - ad + pourcent
                pourcents(x) = pourcent
                .Value = Format(pourcent, "##,##0.00""%""")
            End If
            ad = 0
            For i = 1 To NbSolvants + 1
                Set obj = ActiveSheet.OLEObjects("CheckBoxPP" & i).Object
                If obj = -1 Then ad = ad + pourcents(i)
            Next
            Set obj = this.HostSheet.OLEObjects("TextBox_AddPourcent").Object
            obj.Value = Format(ad, "##,##0.00""%""")
        End With
    End If
End Sub

I chose, for the variables x and i, to assign them the type "byte", because it is about an application in order to carry out dilutions and there will never be more than 255 solvents, at most ten.

 

[GWteB]

I chose, for the variables x and i, to assign them the type "byte", because it is about an application in order to carry out dilutions and there will never be more than 255 solvents, at most ten.

If so then you are indeed on the safe side, but if you aren't specifically looking for an 8 bit value, using a 32 bit long is always more efficient, that's why I changed it.