Format Textbox à la saisie

[cathodique]

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]

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

 

[cathodique]

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]

bonjour cat🙂🙂,bbb38

essai avec ce code

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]

Bonjour cathodique, bbb38, Laetitia, le forum,

Fichier joint avec ce code dans l'USF :

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]

Bonjour, Laetitia90🙂, Job75🙂, Le forum🙂,

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

 

[BOISGONTIER]

Bonjour,

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

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

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]

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]

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]

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]

@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]

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) :

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]

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)

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)

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]

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]

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.