[2016] Limiter la saisie d'une textbox avec module de classe

Bonjour à tous,

Je me suis inspiré du superbe tutoriel D'Emmanuel Tissot sur les modules de classe pour essayer de "simplifier" mon code.
Je souhaite limiter la saisie à certains caractères dans les TextBox commençant par certains caractères. Afin de simplifier plus encore, je souhaitais passer par un module afin de rattacher les TextBox à la classe, et c'est là que ça coince !
Si j'inscrit le code directement dans le UserForm_Initialize, aucun problème, par contre dans le module...
Au niveau du UserForm :

Code:

---

1 2 3

Private Sub UserForm_Initialize() Call forcenum(Me) End Sub

---

Au niveau du module :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15

Public Function forcenum(MeForm As Object) Dim Ctl As MSForms.Control Dim MyNumBox As NumBox Set NumBoxes = New Collection For Each Ctl In MeForm.Controls If TypeOf Ctl Is MSForms.TextBox Then If Left(Ctl.Name, 3) = "nxn" Or Left(Ctl.Name, 4) = "anxn" Then Set MyNumBox = New NumBox 'Crée une nouvelle instance Set MyNumBox.TargetBox = Ctl 'Connecte la variable à l'objet NumBoxes.Add MyNumBox 'Ajoute l'instance à la collection End If End If Next   End Function

---

Et du module de classe :

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

Public WithEvents TargetBox As MSForms.TextBox   Private Sub TargetBox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) Dim i As Integer i = KeyAscii ' If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0 If Not (InStr(1, "-0123456789,", Chr(i), vbBinaryCompare) > 0 Or i = 8) Then If i = 46 Then i = 44 Else i = 0 End If End If KeyAscii = i End Sub   Private Sub TargetBox_Change() 'Evènement Change de la variable   With TargetBox If Len(.Value) - Len(Replace(.Value, ",", "")) > 1 Then .Value = Left(.Value, Len(.Value) - 1) End If If Len(.Value) = 1 And .Value = "," Then .Value = "0," End If If Len(.Value) = 2 And .Value = "-," Then .Value = "-0," End If If Len(.Value) > 1 And Right(.Value, 1) = "-" Then .Value = Left(.Value, Len(.Value) - 1) End If End With   End Sub

---

Avec ce code, je n'ai pas de message d'erreur, mais la saisie n'est en rien limitée ! Le code fait bien la boucle dans le module, en passant par chaque contrôle et en "détectant" ceux qui correspondent à mes critères.
Une personne plus expérimentée que moi aurait une idée ?
Plutôt que "MeForm as Object", j'ai essayé le "MeForm as UserForm", pour un résultat identique !

En vous remerciant par avance,

Wulfram

Bonsoir,


Exemple en PJ

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20

Saisie de 3 caractères   Dim Txt(1 To 12) As New ClasseSaisie Private Sub UserForm_Initialize() For b = 1 To 12: Set Txt(b).GrSaisie = Me("textbox" & b): Next b End Sub   Public WithEvents GrSaisie As MSForms.TextBox Private Sub GrSaisie_Change() If Len(GrSaisie.Value) = 3 Then temp = GrSaisie.Name Position = "" For i = 1 To Len(temp) If IsNumeric(Mid(temp, i, 1)) Then Position = Position & Mid(temp, i, 1) Next i If Val(Position) = 12 Then Position = 0 UserForm1("textbox" & Position + 1).SetFocus End If End Sub

---

Boisgontier

Bonsoir Jacques, et merci pour votre temps.

Votre code est intéressant et me servira sans doute de base à l'avenir pour de nouvelles fonctionnalités, néanmoins il ne répond pas à ma question, que j'ai du mal formuler !

Je ne souhaite pas limiter le nombre de caractères par TextBox (ce que fais votre code, en changeant le focus après 3), mais à limiter les caractères acceptés lors de la saisie, à savoir ceux de la liste : -0123456789,

De plus, le lien entre les zones de textes et le module de classe se fait directement à partir du code du formulaire, ce que j'arrive également à réaliser ; je souhaitais pouvoir faire ce lien via une procédure dans un module distinct, afin de limite le volume de code dans chaque formulaire.

En vous remerciant une fois encore,

Wulfram

bonsoir
met ca dans ton userform

Code:

---

1 2 3 4

Dim cl As New classetextBnum Private Sub UserForm_Activate() cl.initiate Me End Sub

---

ajoute un module classe dans ton classeurque tu nommera "classetextBnum"
dans ce module classe tu met ce code

Code:

---

1 2 3 4 5 6 7 8 9 10 11

Public WithEvents txtbN As MSForms.TextBox Public usf As Object Dim cls() As New classetextBnum Function initiate(uf) For Each ctrl In uf.Controls If ctrl.Tag = "num" Then i = i + 1: ReDim Preserve cls(1 To i): Set cls(i).txtbN = ctrl: Set usf = uf Next End Function Private Sub txtbN_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) If Not Chr(KeyAscii) Like "[0-9-]" Then KeyAscii = 0 End Sub

---

voila maintenant tu met dans le tag de tout tes textboxs concerné le tag"num"
d'aurenavant dans ces textboxs tu ne pourra taper rien d'autre que les chiffre de 0 à 9 et le tiret(symbole moins)

tout simplement c'est pas plus compliqué ;)

Bonjour Patrick,

Merci bien pour ta réponse, le code fonctionne effectivement, même après les petites modifications que je lui ai apporté, que ce soit pour faire le smanipulations que je veux, mais aussi afin de pouvoir me servir de la même classe pour d'autres types de textebox (date, uniquement lettres, ...) qui me serviront dans un avenir proche.
Je vais donc pouvoir remettre tous les début de nom de mes textebox en "txt" plutôt que txt, nxn, dxt, axt, ... en pensant à passer par les tags ! Merci pour cette approche qui n'était pas venu à mon esprit de débutant !
Mon code ressemble donc maintenant à :
Dans le formulaire :

Code:

---

1 2 3

Private Sub UserForm_Activate() cl.initiate Me End Sub

---

Dans le module de classe :

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

Public WithEvents txtbN As MSForms.TextBox Public usf As Object Dim cls() As New classetext Function initiate(uf) For Each Ctrl In uf.Controls If Ctrl.Tag <> "" Then i = i + 1: ReDim Preserve cls(1 To i): Set cls(i).txtbN = Ctrl: Set usf = uf Next End Function Private Sub txtbN_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) With txtbN If .Tag = "num" Then Dim i As Integer i = KeyAscii If Not (InStr(1, "-0123456789,", Chr(i), vbBinaryCompare) > 0 Or i = 8) Then If i = 46 Then i = 44 Else i = 0 End If End If KeyAscii = i End If If .Tag = "dt" Then MsgBox "date !" End If End With End Sub   Private Sub txtbN_Change()   With txtbN If .Tag = "num" Then If Len(.Value) - Len(Replace(.Value, ",", "")) > 1 Then .Value = Left(.Value, Len(.Value) - 1) End If If Len(.Value) = 1 And .Value = "," Then .Value = "0," End If If Len(.Value) = 2 And .Value = "-," Then .Value = "-0," End If If Len(.Value) > 1 And Right(.Value, 1) = "-" Then .Value = Left(.Value, Len(.Value) - 1) End If End If End With   End Sub

---

Bien qu'une (très bonne) solution à mon problème soit trouvée, je e permet de ne pas passer le fil en résolu dès maintenant, pour voir si quelqu'un a une idée de pourquoi je ne pouvais relier les objets à ma classe en passant par un module alors que le même code fonctionnait à partir du code du UserForm...

Sans réponse, je mettrais le tag résolu mardi !

Encore merci à toi,

Wulfram

re
bonsoir c'est pas bon de melanger les choux et le navet dans la classe tu peut tres bien intancier 3 types de textboxs

bon voila j'ai pris 10 minute a perffectionner bien sur

donc dans ton userform on prend les meme et on recommence

Code:

---

1 2 3 4

Dim cl As New specialtextbox Private Sub UserForm_Activate() cl.initiate Me End Sub

---

a noter que j'ai changé le nom de la classe car elle va servir pour des textebox (date , telephone , texte non numerique)

on ajoute donc le module classe que l'on nommera "specialtextbox"

ajoutons le code dans ce module classe :
regarde bien les "publicEvents"
voila comment on instancie x textbox qui auront un comportement differents


donc dans les tag des textboxs tu mettra selon le type que tu veux "date","tel" ou "lettre"
et donc selon le type je corrige le keyascii dans le keypress

dans les evenements change je contraint certaines touche en fonction du len
autrement dis a la redaction tu verra pour les date tu peux pas faire tout ce que tu veux si tu tape pas le separateur("/") par exemple tu ne peux pas aller plus loin
je te laisse annalyser les autre contraintes

pour les telephone je contrain au format francais "xx xx xx xx xx" tout est toto!!matique

pour les textbox non numerique comme je ne sais pas ce que tuva en faire j'ai pas approfondi mais les numerique ne passe pas

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

Public WithEvents textDate As MSForms.TextBox Public WithEvents textTEL As MSForms.TextBox Public WithEvents textLettre As MSForms.TextBox Public usf As Object Dim cls() As New specialtextbox Function initiate(uf) For Each ctrl In uf.Controls If ctrl.Tag = "date" Then i = i + 1: ReDim Preserve cls(1 To i): Set cls(i).textDate = ctrl: ctrl.Tag = "": Set usf = uf If ctrl.Tag = "tel" Then i = i + 1: ReDim Preserve cls(1 To i): Set cls(i).textTEL = ctrl: ctrl.Tag = "": Set usf = uf If ctrl.Tag = "lettre" Then i = i + 1: ReDim Preserve cls(1 To i): Set cls(i).textLettre = ctrl: ctrl.Tag = "": Set usf = uf Next End Function 'on bloque les numerique ou les lettres selon le type de textbox Private Sub textDate_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger): KeyAscii = IIf(Not Chr(KeyAscii) Like "[0-9/]", 0, KeyAscii): End Sub Private Sub textTEL_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger): KeyAscii = IIf(Not Chr(KeyAscii) Like "[0-9 ]", 0, KeyAscii): End Sub Private Sub textLettre_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger): KeyAscii = IIf(IsNumeric(Chr(KeyAscii)), 0, KeyAscii): End Sub   'les contrainte dans les evenement pour chaque type de textbox Private Sub textDate_Change() Dim T$ T = Mid(textDate.Text, 1, 10) If Mid(T, 1, 1) > 3 Then T = "" If Len(T) = 2 And Val(T) > 31 Then T = Mid(T, 1, 1) If Len(T) >= 3 And Mid(T, 3, 1) <> "/" Then T = Mid(T, 1, 2) If Len(T) >= 4 And Val(Mid(T, 4, 1)) > 1 Then T = Mid(T, 1, 3) If Len(T) >= 5 And Val(Mid(T, 4, 2)) > 12 Then T = Mid(T, 1, 4) If Len(T) >= 6 And Mid(T, 6, 1) <> "/" Then T = Mid(T, 1, 5) If Len(T) = 10 And Not IsDate(T) Then MsgBox T & vbCrLf & "la date entrée n'est pas valide" & vbCrLf & "veuillez recommencer": T = "": textDate = T End Sub Private Sub textTEL_Change() Dim T$, mem$ T = Mid(textTEL.Text, 1, 14) mem = textTEL.Tag If (Len(T) = 2 Or Len(T) = 5 Or Len(T) = 8 Or Len(T) = 11) And Len(mem) < Len(T) Then T = T & " " textTEL = T textTEL.Tag = textTEL.Text End Sub     Private Sub textLettre_Change() End Sub

---

un fichier en piece jointe pour que tu puisse t'entrainer
;)

Bonsoir,

Merci bien sur cet exemple illustré de comment utiliser un module de classe à différentes fins, ce sera effectivement bien plus lisible que d'utiliser des "if" un peu partout !

Je me pose néanmoins deux questions purement pratiques en rapport à ton code :

Code:

---

If ctrl.Tag = "date" Then i = i + 1: ReDim Preserve cls(1 To i): Set cls(i).textDate = ctrl: ctrl.Tag = "": Set usf = uf

---

Pourquoi définir un ctrl.tag = "" ?
Cet argument me semble non nécessaire en l'espèce !?

Code:

---

Dim T$

---

Le $ signifie bien "string" ?

Pour ce qui est de la gestion des dates, je vais en fait ne pas la gérer par un module de classe, mais via l’événement BeforeUpdate des textebox concernées. En effet, de tous les codes que j'ai pu trouver sur différents forum (dont celui-ci !), tous semblent soulever un certains nombres de problématiques. Par exemple, et ce n'est pas un reproche, ton code empêche l'utilisateur d'entrer une date au format "1/1/11". Afin d'aiguiller l'utilisateur vers un format dd/mm/yyyy, je pré-remplirais néanmoins la zone de saisie avec la date du jour à ce format. Ce sera, de toute façon, la date la plus souvent utilisée !

Merci encore pour l'aide ! Je passe le sujet en résolu.

re
Bonsoir
.tag="" parce que dans les evenement regarde comment je m'en sert de memoire dans les textboxs telephones
oui le "$" c'est la declaration abrégée de "as string"

oui j'ai formaté les dates "dd/mm/yyyy" tu peux faire autrement si le coeur t'en dit

c'est juste un exemple pour que tu t'entraine a faire ce que tu veux dessus avant de l'intégrer dans ton fichier final
au plaisir