Module de classe pour TextBox

Version imprimable

Bonjour à tous,

J'ai crée un module de classe pour remplacer un traitement répétitif dans l'événement KeyDown des TextBox.

Mais voila, parfois les événements KeyDown des TextBox, contiennent des valeurs différentes et parfois des lignes de commande en plus l'un par rapport à l'autre.

Comment unifier le module de classe, tout en gardant les lignes de codes ou les quelques propriétés en plus.

- Les .Text parfois elle est égal à "", "T" ou "L3-"
- On trouve parfois Selstart dans des Textbox et pas d’autres
Merci.

Les Evenements à remplacer.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Private Sub tbN_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = vbKeyReturn Or KeyCode = vbKeyTab Then
        KeyCode = 0
        With tbTr
            .Text = "T"
            .SelStart = Len(.Text)
            .SetFocus
        End With
    End If
End Sub
 
Private Sub tbTr_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Dim Texte As String
 
    Texte = tbTr.Text
    If Len(Texte) = 4 Then Texte = Texte & "-"
    tbTr.Text = Texte
 
    If KeyCode = vbKeyReturn Or KeyCode = vbKeyTab Then
        KeyCode = 0
        With tbPr
            .Text = ""
            .SetFocus
        End With
    End If
End Sub
 
Private Sub tbPr_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = vbKeyReturn Or KeyCode = vbKeyTab Then
        With tbL3
            KeyCode = 0
            .Text = "L3-"
            .SelStart = Len(.Text)
            .SetFocus
        End With
    End If
End Sub
 
Private Sub tbAD_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = vbKeyReturn Or KeyCode = vbKeyTab Then
        With tbPt
            KeyCode = 0
            .Text = ""
            .SetFocus
        End With
    End If
End Sub

-----
Classe : KeyControlClass-----

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Public WithEvents tbKey As MSForms.TextBox
 
Private Sub tbKey_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = vbKeyReturn Or KeyCode = vbKeyTab Then
        KeyCode = 0
        With tbTr
            .Text = "T" ' on trouve parfois .Text="", parfois .Text = "L3-" : Comment traiter ce probleme ?
            .SelStart = Len(.Text)
            .SetFocus
        End With
    End If
 
End Sub

-----

Appel de la classe

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Dim TBx(1 To 5) As New keyControlClass
 
Private Sub UserForm_Initialize()
    Dim b As Byte
    Dim Ctl As MSForms.Control
    b = 1
    For Each Ctl In Me.Controls
        If TypeOf Ctl Is MSForms.TextBox Then
 
            TBx(b).tbKey = Ctl.Name
            b = b + 1
        End If
    Next Ctl
End Sub

Mais quand j'appel mon userform avec FrmSasie.Show ça bug.

Une solution ?

Merci d'avance.

03/01/2012, 22h56
kiki29

Salut, sans savoir si cela pourra t'aider, mais en l'espérant quand même, voir http://www.developpez.net/forums/d11...orm-dynamique/
03/01/2012, 23h44
apt

Bonsoir kiki29,

C'était pour la création d'un UserForm dynamique.

Moi je cherche à crée un module de classe qui fonctionne avec les textBox de mon userform.

re, effectivement création dynamique d'une UserForm ainsi que de 12 TextBoxes avec le code correspondant pour les évènements Change et KeyPress, adaptable à ton contexte

Une version via des modules de classes, à adapter à ton contexte
Dans UserForm

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Option Explicit
 
Dim TB() As New clsTBox
Dim CB() As New clsCmdB
 
Private Sub UserForm_Initialize()
Dim TxtB As MSForms.TextBox
Dim cmdB As MSForms.CommandButton
Dim i As Integer, iLeft As Integer, iTop As Integer
 
    iLeft = 10: iTop = 10
    For i = 1 To 12
        Set TxtB = Me.Controls.Add("Forms.Textbox.1", , True)
        With TxtB
            .Width = 150
            .Height = 20
            .Left = iLeft
            .Top = iTop
            .BorderStyle = fmBorderStyleSingle
            .SpecialEffect = fmSpecialEffectFlat
 
            Select Case i
                Case 1, 5
                    .BackColor = &HC0E0FF
                Case Else
                    .BackColor = &HC0FFFF
            End Select
 
            .Tag = i
        End With
 
        iTop = iTop + 25
 
        ReDim Preserve TB(1 To i)
        Set TB(i).GroupeTxtB = TxtB
    Next i
 
    ReDim Preserve CB(1 To i)
    Set cmdB = Me.Controls.Add("Forms.CommandButton.1", , True)
    With cmdB
        .Caption = "Ok"
        .Width = usfTextBoxes.Width \ 4
        .Height = 20
        .Left = usfTextBoxes.Width \ 4 + .Width \ 2
        .Top = iTop + 10
    End With
 
    Set CB(1).cmdB = cmdB
End Sub

Dans un module de classe baptisé clsCmdB

Code:

1
2
3
4
5
6
7
Option Explicit
 
Public WithEvents cmdB As MSForms.CommandButton
 
Private Sub cmdB_Click()
    Unload usfTextBoxes
End Sub

Dans un module de classe baptisé clsTBox

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Option Explicit
 
Public WithEvents GroupeTxtB As MSForms.TextBox
 
Const entrees_decimales_permises = ".,0123456789" & vbCr & vbBack
Const entrees_alpha_permises = " ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" & vbCr & vbBack
Const Point = "."
Const Virgule = ","
 
Private Sub GroupeTxtB_Change()
Dim i As Integer
    i = GroupeTxtB.Tag
    Select Case i
        Case 1, 5
            ShTest.Range("A" & i) = GroupeTxtB.Text
        Case Else
            On Error Resume Next
            ShTest.Range("A" & i) = CDbl(GroupeTxtB.Text)
            Err.Clear
    End Select
End Sub
 
Private Sub GroupeTxtB_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Select Case GroupeTxtB.Tag
        Case 1, 5
            If InStr(entrees_alpha_permises, Chr(KeyAscii)) = 0 Then KeyAscii = 0
        Case Else
            If KeyAscii = Asc(Point) Then
                If InStr(GroupeTxtB.Text, Virgule) = 0 Then
                    KeyAscii = Asc(Virgule)
                Else
                    KeyAscii = 0
                End If
            ElseIf InStr(entrees_decimales_permises, Chr(KeyAscii)) = 0 Then
                KeyAscii = 0
            ElseIf InStr(GroupeTxtB.Text, Virgule) > 0 And KeyAscii = Asc(Virgule) Then
                KeyAscii = 0
            End If
    End Select
End Sub

Bonjour à tous,

Ca avance un peu, et voila les evenements KeyDown que je veux remplacer :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Private Sub tbN_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = vbKeyReturn Or KeyCode = vbKeyTab Then
        KeyCode = 0
        With tbTr 'Next TextBox
            'un T au début
            .Text = "T"
            .SelStart = Len(.Text)
            .SetFocus
        End With
    End If
End Sub
Private Sub tbTr_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = vbKeyReturn Or KeyCode = vbKeyTab Then
        KeyCode = 0
        With tbPr 'Next TextBox
            'une chaine vide
            .Text = ""
            .SetFocus
        End With
    End If
End Sub
Private Sub tbPr_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = vbKeyReturn Or KeyCode = vbKeyTab Then
        With tbL3 'Next TextBox
            KeyCode = 0
            'un L3- au début
            .Text = "L3-"
            .SelStart = Len(.Text)
            .SetFocus
        End With
    End If
End Sub
Private Sub tbAD_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = vbKeyReturn Or KeyCode = vbKeyTab Then
        With tbPt 'Next TextBox
            KeyCode = 0
            'une chaine vide
            .Text = ""
            .SetFocus
        End With
    End If
End Sub

Et les evenements MouseDown :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub tbTr_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'un T au début
    tbTr.Text = "T"
End Sub
 
Private Sub tbPr_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'une chaine vide
    tbPr.Text = ""
End Sub
 
Private Sub tbPt_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'une chaine vide
    tbPt.Text = ""
End Sub

Le module de classe ClsTB qui traite les évenements KeyDown et MouseDown des TextBox :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Public WithEvents GrpTB As MSForms.TextBox
 
Private Sub GrpTB_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Dim i As Integer
    Dim Txt As String
 
    i = GrpTB.Tag
 
    Select Case i
    Case 1, 3, 5, 6
        Txt = ""
    Case 2
        Txt = "T"
    Case Else
        Txt = "L3-"
    End Select
 
    If KeyCode = vbKeyReturn Or KeyCode = vbKeyTab Then
        KeyCode = 0
        With GrpTB 'Next TextBox ????
            .Text = Txt
            .SelStart = Len(.Text)
            .SetFocus
        End With
    End If
 
End Sub
 
Private Sub GrpTB_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim i As Integer
 
    i = GrpTB.Tag
 
    Select Case i
    Case 1, 3, 5, 6
        GrpTB.Text = ""
    Case 2
        GrpTB.Text = "T"
    Case Else
        GrpTB.Text = "L3-"
    End Select
 
End Sub

Seulement j'ai du mal à dire au programme de passer au TextBox suivante dans l'évenement KeyDown dans la ligne :

Code:

With GrpTB 'Next TextBox ????

Une piste ?

Merci d'avance.

Bonsoir,

Une solution avec :

Code:

With GrpTB.Parent.Controls("TextBox" & I + 1)

En renomment toutes les TextBox sous leurs noms initiaux :

Citation:

tbN en TextBox1
tbTr en TextBox2
...
tbPt en TextBox6

Mais j'ai un problème : En vérifiant avec Msgbox (MouseDown) j'ai découvert que la 5éme TextBox s'appel TextBox6 et la dernière (6éme) s'appel TextBox6.

Pourtant à l'initialisation, l'attribution d'événements de la classe ClsTB ainsi des Tag aux TextBox, se fait normalement dans l'ordre croissant de 1 à 6.

Alors d'ou vient cette erreur ?

Merci.

EDIT :

Voila la solution (Merci Hasco) :ccool:
Code:

1 2 3 4 5 6 7 8 Dim TBx(1 To 6) As New ClsTB '---- keyControlClass Private Sub UserForm_Initialize() Dim b As Byte For b = 1 To 6 Set TBx(b).GrpTB = Me.Controls("Textbox" & b) TBx(b).GrpTB.Tag = b Next End Sub