Format Textbox à la saisie

cathodique · 28 Mars 2018

Bonsoir,

Je voudrais imposer un format à la saisie dans une textbox qui représente un numéro siret.
Ex: xxx xxx xxx xxxxx (3 chiffres espace 3 chiffres espace 3 chiffres espace 5 chiffres).
Les espaces se rajoutent automatiquement.

C'est à dire si ce format n'est pas respecter la textbox ne perd pas le focus pour corriger.

Merci beaucoup.

Bonne soirée.

bbb38 · 29 Mars 2018

Bonjour cathodique, le forum,
Une solution à tester.
Cordialement,
Bernard

cathodique · 29 Mars 2018

Bonjour bbb38,

Merci beaucoup. J'ai testé mais ne répond pas exactement à ce que je voudrais obtenir.

Il faudrait qu'un espace s’insère automatiquement à la saisie, c-à-d après les 3 premiers chiffres un espace s'insérer tout seul ensuite après les 3 autres chiffres et ainsi de suite. au total la textbox doit avoir 17 caractères.

Merci encore.

Bonne journée.

laetitia90 · 29 Mars 2018

bonjour cat,bbb38

essai avec ce code

VB:

Private Sub TextBox1_KeyPress(ByVal K As MSForms.ReturnInteger)
     Select Case Len(TextBox1)
        Case 0 To 2, 4 To 6, 8 To 10, 12 To 16
        Select Case K
        Case 48 To 57: Case Else: K = 0
        End Select
        Case 3, 7, 11: K = 32
        Select Case K
         End Select
         Case Is > 16: K = 0
    End Select
End Sub

job75 · 29 Mars 2018

Bonjour cathodique, bbb38, Laetitia, le forum,

Fichier joint avec ce code dans l'USF :

Code:

Private Sub TextBox1_Change()
Dim t$, i, x$
t = TextBox1
For i = 1 To Len(t)
    If IsNumeric(Mid(t, i, 1)) Then x = x & Mid(t, i, 1)
Next
x = Left(x, 14)
i = 1
While Mid(x, i, 1) <> ""
    If i = 3 Then x = Left(x, 3) & " " & Mid(x, 4): i = i + 1
    If i = 7 Then x = Left(x, 7) & " " & Mid(x, 8): i = i + 1
    If i = 11 Then x = Left(x, 11) & " " & Mid(x, 12): i = i + 1
    i = i + 1
Wend
TextBox1 = x
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Len(TextBox1) < 17 Then Cancel = True
End Sub

Fonctionne même si l'on fait du copier-coller pour alimenter la TextBox.

Bonne journée.

cathodique · 29 Mars 2018

Bonjour, Laetitia90, Job75, Le forum,

C'est exactement le résultat recherché.
Avec tous mes remerciements.
Bonne journée.

BOISGONTIER · 29 Mars 2018

Bonjour,

Masque de saisie pour no siret & déplacement avec flèches.

http://boisgontierjacques.free.fr/fichiers/Formulaire/MasqueSaisieSiret.xls

Code:

Dim p
Dim masque
Private Sub UserForm_Initialize()
  masque = "... ... ... ....."
  TextBox1 = masque
  p = 0
  TextBox1.SelStart = p
  TextBox1.SelLength = 1
End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  If KeyCode = 8 Or KeyCode = 37 Then  ' flèche gauche et backspace
  KeyCode = 0
  If p > 0 Then p = p - 1
  If p = 3 Or p = 7 Or p = 11 Then p = p - 1
  End If
  If KeyCode = 39 Then  ' flèche droite
  KeyCode = 0
  p = p + 1
  If p = 3 Or p = 7 Or p = 11 Then p = p + 1
  End If
  If Mid(masque, p + 1, 1) = "." Then
  If KeyCode = 46 Then  ' touche suppression
  Me.TextBox1 = Left(Me.TextBox1, p) & "." & Mid(Me.TextBox1, p + 2)
  End If
  If Not (KeyCode >= 48 And KeyCode <= 58 Or _
  KeyCode >= 96 And KeyCode <= 106) Then KeyCode = 0  ' Chiffres & lettes
  End If
  TextBox1.SelStart = p
  TextBox1.SelLength = 1
End Sub

Private Sub TextBox1_Change()
  p = p + 1
  If p = 3 Then p = 4
  If p = 7 Then p = 8
  If p = 11 Then p = 12
  If p = 17 Then p = 0
  TextBox1.SelStart = p
  TextBox1.SelLength = 1
End Sub

Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  p = Me.TextBox1.SelStart
End Sub

Private Sub B_valid_Click()
If InStr(Me.TextBox1, ".") > 0 Then
  MsgBox "saisie incomplete"
  Me.TextBox1.SetFocus
Else
  MsgBox Me.TextBox1
End If
End Sub

JB

cathodique · 29 Mars 2018

Bonjour Boisgontier,

Merci beaucoup mais il n'y a pas de fichier.

c'est le message renvoyé sur la page.

Merci quand même, c'est gentil.

Edit: C'est bon le fichier est téléchargeable. Encore merci.

job75 · 29 Mars 2018

Bonjour JB,

Heureux de te croiser et de voir que tu redeviens très actif sur XLD.

Juste une question : est-ce bien toi ou est-ce Nicole qui utilise ton pseudo ?

A+

job75 · 29 Mars 2018

Re,

BISSON Nicole n'apparaît plus sur XLD et je m'aperçois qu'elle a supprimé la plupart de ses posts - il n'en reste que 3 !

C'est vraiment dommage.

A+

cathodique · 29 Mars 2018

@job75 : En effet, C'est doublement dommage, qu'elle n'apparaisse plus et qu'elle supprime ses pertinents posts.

Mais pourquoi donc, il doit y avoir une cause?

@+

job75 · 29 Mars 2018

Re,

Le code de mon post #5 ne permet pas l'effacement par la touche <Retour arrière> (au dessus de la touche <Entrée>).

Avec ceci pas de problème (l'espace s'insère après la frappe des 4ème, 8ème, 12ème chiffres) :

Code:

Private Sub TextBox1_Change()
Dim t$, i, x$
t = TextBox1
For i = 1 To Len(t)
    If IsNumeric(Mid(t, i, 1)) Then x = x & Mid(t, i, 1)
Next
x = Left(x, 14)
i = 1
While Mid(x, i, 1) <> ""
    If i = 4 Then x = Left(x, 3) & " " & Mid(x, 4): i = i + 1
    If i = 8 Then x = Left(x, 7) & " " & Mid(x, 8): i = i + 1
    If i = 12 Then x = Left(x, 11) & " " & Mid(x, 12): i = i + 1
    i = i + 1
Wend
TextBox1 = x
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Len(TextBox1) < 17 Then Cancel = True
End Sub

Fichier (2).

A+

Eric C · 29 Septembre 2019

Bonjour le forum
Bonjour aux contibuteurs(trice)

Je me permets de "déterrer" ce fil très intéressant qui permet de très très belles orientations quant à la saisie dynamique dans un TextBox. Des réponses soumises, j'ai retenu celle de notre ami job75 (que je salue au passage - Gérard si tu me lis ). A force de persévérance (non ... je rigole.. quoique...), j'ai réussi à me faire un petit tableau où j'insère les différents chiffres et les ponctuations que je désire afin de m'y retrouver dans le code (Ici pour un format particulier de n° de téléphone)

VB:

While Mid(x, i, 1) <> ""
    If i = 4 Then x = Left(x, 3) & " " & Mid(x, 4): i = i + 1
    If i = 5 Then x = Left(x, 4) & "/" & Mid(x, 5): i = i + 1
    If i = 6 Then x = Left(x, 5) & " " & Mid(x, 6): i = i + 1
    If i = 10 Then x = Left(x, 9) & " " & Mid(x, 10): i = i + 1
    If i = 13 Then x = Left(x, 12) & " " & Mid(x, 13): i = i + 1

Mon souhait : Arriver à transposer le code de job75 afin de pouvoir réaliser une saisie alphanumérique. Je bute grave sur cette boucle que je n'arrive pas à "chunter" (désolé mais la programmation pure n'est pas mon fort)

Code:

For i = 1 To Len(t)
    If IsNumeric(Mid(t, i, 1)) Then x = x & Mid(t, i, 1)
Next

D'avance, merci à vous & bon dimanche
@+ Eric c

patricktoulon · 29 Septembre 2019

bonsoir
je te propose un textbox siret avec mask de saisie
touche numerique,back,suppr,fleche doite et gauche ,je te laisse faire ce que tu veux avec la touche enter case 13

Eric C · 30 Septembre 2019

Bonjour le forum
Bonjour patricktoulon

Merci beaucoup pour ce fichier. Toutefois, ce n'est pas ce que je recherche. Je reconnais qu'à l'origine, ce post fait référence à la saisie d'un n° SIRET de sté.
J'ai retenu le fichier de notre ami job75 qui pour ma part, me permet de saisir d'autre formats spéciaux en retenant"l'ossature ou l'architecture" du code proposé.
While Mid(x, i, 1) <> ""
If i = 4 Then x = Left(x, 3) & " " & Mid(x, 4): i = i + 1
If i = 5 Then x = Left(x, 4) & "/" & Mid(x, 5): i = i + 1
If i = 6 Then x = Left(x, 5) & " " & Mid(x, 6): i = i + 1
If i = 10 Then x = Left(x, 9) & " " & Mid(x, 10): i = i + 1
If i = 13 Then x = Left(x, 12) & " " & Mid(x, 13): i = i + 1
Ce que je désirerais, c'est garder la partie ci-dessus mais en faisant en sorte que la saisie dans le TexttBox puisse être Alphanumérique.
Encore merci et bonne journée.

Format Textbox à la saisie

cathodique

XLDnaute Barbatruc

Pièces jointes

bbb38

XLDnaute Accro

Pièces jointes

cathodique

XLDnaute Barbatruc

laetitia90

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

cathodique

XLDnaute Barbatruc

BOISGONTIER

XLDnaute Barbatruc

Pièces jointes

cathodique

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

cathodique

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

Eric C

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Pièces jointes

Eric C

XLDnaute Barbatruc

Discussions similaires