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.