Textbox Format de saisie

Le 04/12/2018 à 11:13

Bonjour à tous.

J'aimerai que ds TextBox "Num DE TEL qui se trouve ds une Userform lorsque je saisi le num de télephone j'obtienne l'affichage de type --> Image Num DE TEL OK.

Ne pas tenir compte des chiffres mais du " . "

J'ai essayé ces deux codes:

N°1

Private Sub TxtNumTel_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If InStr("0123456789", Chr(KeyAscii)) = 0 Then KeyAscii = 0 Me.TxtNumTel.MaxLength = 14
    If Len(Me.TxtNumTel) = 2 Or Len(Me.TxtNumTel) = 5 Or Len(Me.TxtNumTel) = 8 Or Len(Me.TxtNumTel) = 11 Then Me.TxtNumTel = Me.TxtNumTel & "."

End Sub

N°2

Private Sub TxtNumTel_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If InStr("0123456789", Chr(KeyAscii)) = 0 Then KeyAscii = 0

     Texte = TxtNumTel.Text              'format texte
Select Case Len(Texte)                   'Sélection des "cases"
Case 2, 5, 8, 11
Texte = Texte & "."                      'Séparateur des "cases"
End Select
TxtNumTel.Text = Texte
End Sub

Cela fonctionne pas vraiment correctement.

à la première saisie j’obtiens --> Image Num DE TEL .c à dire 0.60.70.80.58

Si je supprime ma saisie ,sans fermer l'Userform et que je refais le num de tél alors le format est correct --> Image Num DE TEL OK.

Si je ferme l'userform et que je fais une nouvelle saisi alors je retrouve le même problème .

Je suis dessus depuis lundi et je ne trouve pas

Une idée du pourquoi ?

Merci de votre aide et bonne journée

Ledzep

num de tel ok num de tel
Le 04/12/2018 à 12:46

Salut LedZep,

Je ne comprend pas à quoi sert le KeyPress dans ton code, mais pour mettre au format voulu je te propose :

Private Sub TextBox1_Change()
If Len(TextBox1.Value) <> 10 Then Exit Sub
TextBox1.Value = Replace(Format(TextBox1.Value, "0# ## ## ## ##"), " ", ".")
End Sub

Et si joint le fichier à tester

Restant à ta dispo !

24pour-ledzep.xlsm (18.15 Ko)
Le 04/12/2018 à 13:01

Bonjour

a voir si ca te va

Private Sub TxtNumTel_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Call CHIF_TEPH(KeyAscii, 10)
End Sub

Private Sub CHIF_TEPH(KeyAscii, C)
Dim AKey$
AKey = "[01234567989]"
If Not ChrW(KeyAscii) Like AKey Then KeyAscii = 0
If Len(Controls("TextBox" & C)) = 14 Then KeyAscii = 0: Exit Sub
    Select Case Len(Controls("TextBox" & C))
        Case 2, 5, 8, 11
            If ChrW(KeyAscii) <> " " Then KeyAscii = Asc(" ")
    End Select
End Sub

A+

Maurice

Le 08/12/2018 à 15:44

Bonjour à tous,

Merci pour votre aide sur le sujet

Juice.

J'ai exploité ta piste, et adapté à mon idée.

_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) Interdit la saisie de lettre.

Je l'ai trouvé sur un développement que j'avais fait il y a bien longtemps

Archer.

J'ai tesé ton code , hélas cela ne fonctionne pas , mais je vais essayer de le rendre fonctionnelle, par contre cela va prendre du tps car je me forme. donc je visite pas mal de sujet quand j'ai une erreur.

Pour vous et autres du site voici mon code qui résulte de votre participation.

      'PROCEDURE SAISIE TxtboxNumTel EN FORMAT 00.00.00.00.00 CHIFFRE OBLIGATOIRE

 Private Sub TxtNumTel_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If InStr("0123456789", Chr(KeyAscii)) = 0 Then KeyAscii = 0        'Interdit la saisie des lettres
    Me.TxtNumTel.MaxLength = 14                                        'Nombre de chiffres maxi

    If Len(TxtNumTel.Value) <> 10 Then Exit Sub
    TxtNumTel.Value = Replace(Format(TxtNumTel.Value, "0# ## ## ## ##"), " ", ".")  'Format en fin de saisie 00.00.00.00.00

End Sub

J'aurais pu mettre Me.TxtNumTel.MaxLength = 14 Ds la propriété de la TextBox " MaxLenght de 0 --> à 14.

J'ai préféré ce mode pour avoir directement l'info.

Voila si cela vous conviens ( correction pour "régle de l'art en écriture du code) , je garde ce code.

Merci encore aux aides apportées

A plus sur le Forum

Ledzep

Le 08/12/2018 à 18:18

Bonjour

je préfère comme ca a voir

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If InStr("0123456789", Chr(KeyAscii)) = 0 Then KeyAscii = 0: Beep: Exit Sub
    If Len(TextBox1) = 14 Then KeyAscii = 0: Beep: Exit Sub
    Select Case Len(TextBox1)
        Case 2, 5, 8, 11
            TextBox1 = TextBox1 & "."
    End Select
End Sub

A+

Maurice

Le 09/12/2018 à 18:03

Bonjour Archer

J'ai testé ton code, je me retrouve ds la même situation que quand j'ai fait mon post, c'est à dire comme en PJ.

Par contre j'ai trouvé pourquoi.

Si tu sélectionnes la texbox avec le clic de la sourie pour y entrer le numéro de tél tu obtient 0.60.70.80.58

Par contre si tu tabules pour aller chercher la textboxs alors le format est: 06.07.08.05.80

Donc le clic est à supprimer .

Alors là , je ne sais pas comment faire !

Une idée Maurice ?

Merci de ton aide

A Plus sur le forum

Ledzep

num de tel
Le 09/12/2018 à 18:59

bonjour

tu doit avoir un truc qui marche pas car cher moi ses bon

si tu peux donner un modèle de ton fichier

A+

Maurice

Le 10/12/2018 à 16:39

Bonjour Archer

Ton code fonctionne très bien , je l'ai vérifié avec un fichier vierge.

Donc j'ai refais la manip sur le mien, le même résultat ca ne fonctionne pas tjrs.

J'ai relu relu, je ne trouve ps mon erreur.

Voici le fichier en PJ

Il est en construction, pas encore fin par manque de tps.

Pourvu qu'il soit terminé pour le 02-02-19 c'est le principal.

Un autre soucis aussi avec "datepart" 'PROCEDURE AFFICHAGE N° SEMAINE DS CboNumSemPtot " TxtDDO "

Si tu peux aussi y regarder svp.

Merci de ton aide et remarques sur le début de mon code.

Bonne fin de journée

Ledzep

19pour-archer.xlsm (65.10 Ko)
Le 10/12/2018 à 17:14

Bonjour

Je viens de résoudre le problème de "DatePart"

par

        'PROCEDURE AFFICHAGE N° SEMAINE DS CboNumSemPtot  " TxtDDO "

Private Sub TxtDDO_Change()

CboNumSemPTot.Value = "S" & DatePart("ww", TxtDDO.Value, vbMonday, vbFirstFourDays)

End Sub

J'avais oublié de mentionner vbMonday, vbFirstFourDays.

Le forum regorge d'explication, il suffit de poser la bonne requête.

A plus sur le forum

Ledzep

Le 10/12/2018 à 19:07

Bonsoir

dans les propriétés de TxtNumTel,value tu avait un espace

retour de ton fichier modifier

A+

Maurice

32pour-archer.xlsm (65.03 Ko)
Le 10/12/2018 à 22:53

Bonsoir Archer

Alors chapeau bas Maurice.

Sans ton expertise je n'y serais pas arriver.

Grand merci

PS: j'espère te retrouver pour la suite des mes posts, car j'ai encore du pain sur la planche, mais je progresse grace à VOUS

Bonne soirée

Ledzep

Le 11/12/2018 à 11:38

Bonjour

une dernière a voir

et bon courage

A+

Maurice

23pour-archer.xlsm (66.62 Ko)
Le 24/12/2018 à 17:02

Bonjour à tous

Bonjour Archer

Merci pour ton nouveau code.

J'ai continué mon fichier et je n'avais pas vu le tiens.

J'ai pris et lu ton code , je vais pouvoir l'utiliser quand j'aurais terminé celui-ci, cela me servira pour découvrir une autre méthode.

avec le même fichier. Apprentissage tjrs intéressant.

Bon Noël Archer

Et aussi à ceux de passage sur ce post, qui est maintenant résolu.

Ledzep

Rechercher des sujets similaires à "textbox format saisie"