[XL-2007] Masque de saisie [Résolu]

[apt]

Bonsoir à tous,

J'ai beau cherché un exemple sur les masques de saisie dans les UserForm, mais rien de trouver.

Alors, je souhaite qu'un tel masque :

"___ __ __ __"

apparaisse dans la textbox et que je n'ai qu'à saisir un numéro de téléphone comme ceci : 012320082 pour qu'il soit afficher :

012 32 00 82

(Les chiffres remplacent les _).

Est-ce possible ?

Merci.

[LouiMz]

Bonjour,

Un post traite déjà de ce problème : Masques de saisie

[apt]

Bonsoir LouiMz;

Mais les tirets ou ça doit être la saisie, n'apparaissent pas !

[Jean-Pierre49]

Bonjour

Avec SelStart

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
Option Explicit
                            Dim LeTexte                 As String
                            Dim chargement              As Boolean
Private Sub TextBox1_Change()
                            Dim Val                     As String
                            Dim Ind                     As Byte
 
    Ind = TextBox1.SelStart
    Val = Left(TextBox1.Value, TextBox1.SelStart)
 
    If Len(Val) > 12 Then
        TextBox1.Value = Left(Val, 12)
        Exit Sub
    End If
 
    If Len(Val) = 3 Or Len(Val) = 6 Or Len(Val) = 9 Then
        Val = Val & " "
        Ind = Len(Val)
    End If
 
    Val = Val & Right(LeTexte, Len(LeTexte) - Ind)
    TextBox1.Value = Val
    TextBox1.SelStart = Ind
End Sub
Private Sub UserForm_Initialize()
    LeTexte = "___ __ __ __"
    TextBox1.Value = LeTexte
    TextBox1.SelStart = 0
End Sub

Tu dis

[apt]

Bonsoir Jean-Pierre,

Le masque s'affiche normalement, et les touches "Back space" et "Suppr" n'effacent pas les tirets, mais reste que les chiffres refusent d'être saisies.

Bonjour,

Y a-t-il un moyen pour résoudre ce problème ?

Merci.

[LouiMz]

Bonjour,

Pouvez-vous poster votre code afin que nous puissions vous répondre efficacement ?

[apt]

Bonsoir LouiMz,

J'utilise le code de Jean-Pierre49 en haut.

[apt]

Bonjour,

Je viens de créer un nouveau UserForm avec un TextBox au lieu d'intégrer le code dans mon projet comme je l'avais fait.

Le masque s’affiche et les chiffres s'écrivent normalement.

Maintenant j'aimerais reproduire les touches "Back Space" et "Suppr" sur le texte du Textbox parce que l'effacement pour le "Back Space" s'arrête lorsqu'elle rencontre le premier espace entre les tirets et "Suppr" lorsqu'elle est utilisée, efface tout le texte dans le TextBox.

Merci d'avance

Edit :

Nouveau fichier en PJ.

[apt]

Bonsoir,

Une autre alternative non concluante :

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
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
 
Option Explicit
Dim LeTexte As String
Dim chargement As Boolean
Dim posinex As Byte
Dim flag As Boolean
Dim poscur As Byte
 
Private Sub TextBox1_Change()
Dim Val As String
Dim Ind As Byte
Dim i As Byte
If flag = True Then Exit Sub
i = TextBox1.SelStart
If i < poscur Then
    TextBox1.SelStart = i
    poscur = i
    Label1.Caption = i - 1
    Exit Sub
End If
 
formatagetextbox
TextBox1.SelStart = 12
poscur = 12
For i = 1 To 12
    If Mid(TextBox1, i, 1) = "_" Then
        TextBox1.SelStart = i - 1
        poscur = i - 1
        Label1.Caption = i - 1
        Exit For
    End If
Next i
 
 
End Sub
 
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
 
If KeyAscii < 48 Or KeyAscii > 57 Or _
 Len(Replace(TextBox1, "_", "")) = 12 Then
    KeyAscii = 0
    Exit Sub
End If
End Sub
Private Sub formatagetextbox()
Dim Data1 As String
Dim Data2 As String
Dim i As Byte
Dim j As Byte
flag = True
' formatage des données
Data1 = Replace(TextBox1, "_", "")
Data1 = Application.WorksheetFunction.Trim(Data1)
Data1 = Replace(Data1, " ", "")
j = 1
For i = 1 To 12
    Select Case i
        Case 1, 2, 3, 5, 6, 8, 9, 11, 12
            If IsNumeric(Mid(Data1, j, 1)) Then
                Data2 = Data2 & Mid(Data1, j, 1)
                j = j + 1
            Else
                Data2 = Data2 & "_"
            End If
        Case 4, 7, 10
            Data2 = Data2 & " "
    End Select
Next i
TextBox1 = Data2
flag = False
End Sub
 
Private Sub UserForm_Initialize()
    LeTexte = "___ __ __ __"
'              123456789012
    TextBox1.Value = LeTexte
    TextBox1.SelStart = 0
End Sub

La procédure TextBox1_KeyPress permet de gérer les codes et la longueur du texte.

La procédure TextBox1_Change permet de gérer soit le formatage des données ou la position du curseur. Cela fonctionne si on supprime un symbole numérique et un seul.

[patricktoulon]

bonjour a tous

sans vouloir blésser qui que ce soit
je trouve que c'est beaucoup pédaler pour un simple masque de saisie

essaie ca dans un userform avec un textbox

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
 
Const entrees_entieres_permises = "0123456789"
Const chainevide = "___ __ __ __" ' la chaine representant le masque
Dim newchaine As String ' variable string qui va comporté toute les touche tapée
Private Sub TextBox1_Change()
 
TextBox1 = newchaine & Mid(chainevide, Len(newchaine) + 1, Len(chainevide) - Len(newchaine) + 1)
 
End Sub
 
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If InStr(entrees_entieres_permises, Chr(KeyAscii)) = 0 Then KeyAscii = 0
        If Len(newchaine) = 12 Then
        Exit Sub
    Else
        newchaine = newchaine & Chr(KeyAscii)
 
 If Len(newchaine) = 3 Or Len(newchaine) = 6 Or Len(newchaine) = 9 Then newchaine = newchaine & " "
    TextBox1.SelStart = Len(newchaine)   
End If
       End Sub
 
 
Private Sub UserForm_Activate()
newchaine = ""
TextBox1.SelStart = 0
End Sub

au plaisir

[apt]

Bojour Patrick,

Merci pour ta réponse, mais désolé ça ne gère pas les touches "BackSpace" et "Suppr".



Edit :

Un autre essai (jp14) :

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
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
Option Explicit
Dim Posinex As Byte, SuppInd As Byte
Dim tablo(1 To 12) As String * 1
 
Private Sub TextBox1_Change()
Label2.Caption = TextBox1.SelStart 'Posinex
End Sub
 
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
'___ __ __ __
'123456789012
 
If KeyCode = 8 Then '-- BackSpace Key
Posinex = TextBox1.SelStart
 
Label4.Caption = Posinex
Select Case TextBox1.SelStart
    Case 1, 2, 3, 6, 9, 12
        tablo(TextBox1.SelStart) = "_"
        consttext
        TextBox1.SelStart = Posinex - 1
    Case 5, 8, 11
        tablo(TextBox1.SelStart) = "_"
        consttext
        TextBox1.SelStart = Posinex - 2
    Case 4, 7, 10
        tablo(TextBox1.SelStart) = " "
        consttext
        TextBox1.SelStart = Posinex - 1
End Select
KeyCode = 0
End If
 
'___ __ __ __
'123456789012
 
If KeyCode = 46 Then '-- DEL Key
Posinex = TextBox1.SelStart
SuppInd = TextBox1.SelStart
 
Label6.Caption = Posinex
Select Case TextBox1.SelStart
    Case 0, 1, 4, 7, 10, 11
        tablo(TextBox1.SelStart + 1) = "_"
        consttext
        TextBox1.SelStart = Posinex + 1
    Case 2, 5, 8
        tablo(TextBox1.SelStart + 1) = "_"
        consttext
        TextBox1.SelStart = Posinex + 2
 
    Case 3, 6, 9
        tablo(TextBox1.SelStart + 1) = " "
        consttext
        TextBox1.SelStart = Posinex + 1
 
End Select
 
KeyCode = 0
End If
End Sub
 
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
 
If KeyAscii < 48 Or KeyAscii > 57 Or _
 Len(Replace(TextBox1, "_", "")) = 12 Then
    KeyAscii = 0
    Exit Sub
End If
 
Posinex = TextBox1.SelStart
Label10.Caption = SuppInd
 
'___ __ __ __
'123456789012
 
Label8.Caption = Chr(KeyAscii)
 
Select Case TextBox1.SelStart
    Case 0, 1, 4, 7, 10, 11
        tablo(TextBox1.SelStart + 1) = Chr(KeyAscii)
        consttext
        TextBox1.SelStart = Posinex + 1
    Case 2, 5, 8
        tablo(TextBox1.SelStart + 1) = Chr(KeyAscii)
        consttext
        TextBox1.SelStart = Posinex + 2
End Select
KeyAscii = 0
End Sub
 
Private Sub UserForm_Initialize()
Dim i As Byte
    For i = 1 To 12
    tablo(i) = "_"
    Next i
    tablo(4) = " "
    tablo(7) = " "
    tablo(10) = " "
    consttext
    TextBox1.SelStart = 0
End Sub
Private Sub consttext()
Dim i As Byte
TextBox1 = ""
For i = 1 To 12
    TextBox1 = TextBox1 & tablo(i)
Next i
End Sub

Mais reste que je cherche à mémoriser la position d'ou à commencer la suppression dans la variable

Code :

SuppInd = TextBox.Selstart

En utilisant la touche "Suppr" les chiffres sont supprimés mais le curseur ne revient pas à la position d'ou on a utilisé la touche "Suppr" pour écrire à nouveau les chiffres, ce qui fait qu'ils sont écris depuis le dernier caractère effacé.
J’ai ajouté dans la version v3, le traitement des espaces entres les tirets.

[patricktoulon]

bonjour apt

tien voila un exemple qui gere la touche effacer(keycode 8)
je travaille encore sur la touche supp
j'ai créé une fonction (texte_formaté)

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
 
Private Const chainevide = "_________"
Private newchaine As String
Private curseur As Long
Private Sub TextBox1_Change()
    TextBox1 = texte_formaté: TextBox1.SelStart = curseur
End Sub
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If Len(newchaine) > 0 Then
    If KeyCode = 8 Then newchaine = Left(newchaine, Len(newchaine) - 1)
        End If
End Sub
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If InStr("0123456789", Chr(KeyAscii)) = 0 Then KeyAscii = 0
    If Len(newchaine) < 9 Then
        newchaine = newchaine & Chr(KeyAscii)
       Else
        Exit Sub
    End If
End Sub
Private Sub UserForm_Activate()
    newchaine = ""
End Sub
Function texte_formaté()
Dim chaine As String
lg_chne = Len(newchaine)
'on ajoute les tirets corespondants au chiffres manquants
chaine = newchaine & Mid(chainevide, lg_chne + 1, 12 - lg_chne + 1)
'maintenant on ajoute les espaces (separateur)
texte_formaté = Mid(chaine, 1, 3) & " " & Mid(chaine, 4, 2) & " " & Mid(chaine, 6, 2) & " " & Mid(chaine, 8, 2)
'on determine laposition du curseur
curseur = InStr(texte_formaté, "_") - 1 'renvoie la position de la premiere occurence ("_") disponible
End Function

au plaisir

[apt]

Bonjour Patrick,

Ca donne une erreur dans la ligne :

Code :

TextBox1.SelStart = curseur

Impossible de définir la propriété SelStart. Valeur de propriété non valide

[patricktoulon]

bonjour


j'avoue que je ne comprend pas bien pourquoi

cela dit j'ai modifié un peu le code

tiens essaie ca :

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
 
Private Const chainevide = "_________"
Private newchaine As String
Private curseur As Long
Private Sub TextBox1_Change()
    TextBox1 = texte_formaté
End Sub
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
   'on press la touche effacer
    If KeyCode = 8 Then TextBox1 = texte_moins_un
    'on press la touche supp
    If KeyCode = 46 Then TextBox1 = texte_coupé
End Sub
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If InStr("0123456789", Chr(KeyAscii)) = 0 Then KeyAscii = 0
    If Len(newchaine) < 9 Then
        newchaine = newchaine & Chr(KeyAscii)
 
       Else
        Exit Sub
    End If
End Sub
Private Sub UserForm_Activate()
    newchaine = ""
End Sub
'fonction qui va gérer la touche effacer
Function texte_moins_un()
 If Len(newchaine) > 0 Then newchaine = Left(newchaine, Len(newchaine) - 1)
End Function
 
Function texte_formaté()
Dim chaine As String
lg_chne = Len(newchaine)
'on ajoute les tirets corespondants au chiffres manquants
chaine = newchaine & Mid(chainevide, lg_chne + 1, 12 - lg_chne + 1)
'maintenant on ajoute les espaces (separateur)
texte_formaté = Mid(chaine, 1, 3) & " " & Mid(chaine, 4, 2) & " " & Mid(chaine, 6, 2) & " " & Mid(chaine, 8, 2)
'on determine laposition du curseur
 
If Len(newchaine) < 9 Then TextBox1.SelStart = InStr(texte_formaté, "_") - 1 'renvoie la position de la premiere occurence ("_") disponible
 
End Function

chez moi ca fonctionne tres bien !

je travaille toujour sur la touche supp

au plaisir

tiens voila
maintenant on gere la touche supp

mais il me reste encore a positioner le curseur a l'endroit ou se trouvait le curseur au moment de l'appui sur la touche supp

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
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
 
Private Const chainevide = "_________"
Private newchaine As String
Private reprise As Boolean
Dim i As Long, pointo As Long
Private Sub TextBox1_Change()
    TextBox1 = texte_formaté
End Sub
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
'on press la touche effacer
    If KeyCode = 8 Then TextBox1 = texte_moins_un
    'on press la touche supp
    If KeyCode = 46 Then
    TextBox1 = texte_coupé
reprise = True
End If
End Sub
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If InStr("0123456789", Chr(KeyAscii)) = 0 Then KeyAscii = 0
    pointo = TextBox1.SelStart
    If Len(newchaine) < 9 Then
                If IsNumeric(Mid(TextBox1, pointo + 1, 1)) Then
            chaine1 = Mid(newchaine, 1, pointo - 1)
            chaine2 = Mid(newchaine, pointo, Len(newchaine) - Len(chaine1) - 1)
            newchaine = chaine1 & Chr(KeyAscii) & chaine2
 TextBox1.SelStart = pointo
      Else
            newchaine = newchaine & Chr(KeyAscii)
     End If
    Else
        Exit Sub
    End If
TextBox1.SelStart = pointo
End Sub
Private Sub UserForm_Activate()
    newchaine = ""
TextBox1.SelStart = 0
End Sub
'fonction qui va gérer la touche effacer
Function texte_moins_un()
    If Len(newchaine) > 0 Then newchaine = Left(newchaine, Len(newchaine) - 1)
    'TextBox1.SelStart = InStr(TextBox1, "_")
reprise = False
End Function
Function texte_formaté()
    Dim chaine As String
    newchaine = newchaine & chiffre
    lg_chne = Len(newchaine)
    'on ajoute les tirets corespondants au chiffres manquants
    chaine = newchaine & Mid(chainevide, lg_chne + 1, 12 - lg_chne + 1)
    'maintenant on ajoute les espaces (separateur)
    texte_formaté = Mid(chaine, 1, 3) & " " & Mid(chaine, 4, 2) & " " & Mid(chaine, 6, 2) & " " & Mid(chaine, 8, 2)
    'on determine laposition du curseur
    If Len(newchaine) < 9 Then
       If reprise = False Then TextBox1.SelStart = InStr(texte_formaté, "_") - 1   'renvoie la position de la premiere occurence ("_") disponible
    If reprise = True Then TextBox1.SelStart = pointo
 End If
reprise = False
End Function
Function texte_coupé()
reprise = True
    i = TextBox1.SelStart
    chaine1 = Mid(newchaine, 1, i - 1)
    chaine2 = Mid(newchaine, i + 1, Len(newchaine) - Len(chaine) - 1)
    newchaine = chaine1 & chaine2
TextBox1.SelStart = Len(chaine1)
End Function

je perfectionne le code patience

au plaisir

[apt]

Bonsoir Patrick,

La touche supprime depuis la derniere position et non pas depuis l'endroit du curseur, en plus elle efface deux chiffres au maximum !!!

[Ormonth]

Bonjour,

@ apt, tu peux t'inspirer de la démarche de ce tuto, même le copier-coller est prévu...

Approche d'une résolution de besoin en VBA niveau débutant
Obliger une saisie numérique dans une TextBox

Cordialement,

Ps : si le côté technique de la réponse = OK ou pas => pensez à cliquer sur les pouces et quand question résolue à la taguer résolue, et chaque action vous rapporte des points

Didier

[patricktoulon]

bonjour apt

j'ai oublié de te dire que pour utiliser la touche supp il fallait positioner le curseur ou tu voulais supprimer le chiffre
sinon il n'y a aucun interet a utiliser la touche supp
puisque la touche effacer suprime le dernier chifre de droite vers la gauche

enfin c'est une question de logique

je suis en train de travailler sur une autre solution
au plaisir

[apt]

Bonsoir Ormonth, Patrick

@ apt, tu peux t'inspirer de la démarche de ce tuto, même le copier-coller est prévu...

Merci pour les liens

sinon il n'y a aucun interet a utiliser la touche supp
puisque la touche effacer suprime le dernier chifre de droite vers la gauche

J'ai testé la suppression depuis le milieu

je suis en train de travailler sur une autre solution

J'aimerais bien connaitre ta nouvelle solution

[patricktoulon]

bonjour


ben voila une solution complète

en effet ce qui a été difficile sur ce problème c'est la façon des fonctions d'origine du textbox ont de traiter

puis en allant au plus simple en observant le comportement du textbox quant on tape des caractères dessus sans macro

je me suis aperçu que l'on pouvait contourner le problème

les problèmes étant :

le remplissage du texte box avec 12 caractères espaces et tiret compris
le placement du curseur selon la touche tapé
le pavé numérique
la touche effacer
la touche suppr
les flèches droites et gauche
et mon joker la touche étoile du paver numérique

en fait j'ai changer de stratégie
je ne me sert plus de "textbox_keypress" pour déterminer le caractère tapé
puisque sans macro le caractères s'inscrit quand on le tape

en fait la stratégie n'est plus de construire la chaîne numérique mais de la récupérer dans le textbox

ensuite on ajoute la partie droite de la chaîne vide préformatée correspondant au caractère manquant de la chaîne numérique
a la chaîne vide qui a été déclarée en constante en haut de module

voila pour la chaîne rendu dans la textbox

ensuite on doit placer le curseur en fonction de ce que l'on vient de taper

pour cela dans cette 4 eme version j'utilise la fonction"textbox_keydown"

ensuite en fonction de la situation du textbox et de ce que tu a fait 1 coup en arrière le curseur est placé
le principe:
1° pour les caractères(chiffre ,tiret,espace)
au départ tu a un textbox vide donc il est inscrit dedans "___ __ __ __"
ensuite tu tape un chiffre
il s'inscrit dans le textbox
ensuite dans la fonction textbox_change
on boucle sur tout les caracteres y compris les espaces
on en récupère les caractères numériques dans la variable "chaîne"
on met une condition sur la longueur de la chaîne
si c'est 3 ou 6 ou 9 la chaine est egale a la chaine + un espace
nous voila donc avec la variable chaine formaté selon ton style désiré
ensuite si la chaine numerique n'est pas complete on la complete avec la partie droite de la chaine vide correspondant au caracteres manquants
il nous reste plus qu'a inscrire le tout dans le textbox

2°nous allons gérer ici le curseur a l'aide de la fonction "textbox_keydown"
si je tape sur le pavé numerique et que je n'est pas tapé sur les touche supp et effacer alors le curseur est egale a la longeur de la chaine+1
si j'ai tapé auparavent sur la touche supp ca veut dire que j'ai modifié une partie de la chaine numerique qui etait deja en place je bloque donc le curseur a l'endroit ou jai supprimer pour pouvoir réécrire un chiffre ou plusieur
si j'ai tapé sur la touche effacer je recule le curseur d'une position puisqu'en meme temp il eface le dernier chiffre

je me sert aussi de la fonction "TextBox1_DblClick"
en effet naturellement et sans macro quand tu double clic dans un textbox rempli a l'endroit du curseur si le text est separé par des espaces seul la portion de text est sélectionnée en bleu

dans ce cas la si tu tape sur la touche supp toute la partie est supprimé

autant s'en servir pour par exemple supprimer un des 4 groupe de chiffre
le curseur est positionné alors a l'endroit ou doit démarrer le debut de ce groupe

je me suis servie de la touche etoile comme jocker elle efface tout et remet la chaine vide préformaté

assez de blabla voila le code a metre dans ton userform avec un textbox

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
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
'************************************************************************************************************************************
'*                                SUJET:FORMATER UN TEXTBOX DYNAMIQUEMENT AVEC MASQUE DE SAISIE                                     *
'*                                                                                                                                  *
'*                                                HAUTEUR : patricktoulon pour DVP                                                  *
'*                                                                                                                                  *
'*                                                   FORMAT DE BASE: "000 00 00 00"                                                 *
'*                                                                                                                                  *
'*                                                          VERSION N° 4                                                            *
'*                                                                                                                                  *
'* Avec cette version on va formater la chaine a chaque pression sur une touche que l'on completera avec la chaine vide préformatée *
'*                                                                                                                                  *
'************************************************************************************************************************************
 
 
Const chainevide = "___ __ __ __"   'chaine vide Préformatée representant les 9 chiffres vides(non renseigné)
Dim pointeur As Long                'variable qui sera renseignée pour déterminer l'emplacement du curseur
Dim chaine As Variant               'variable alimentée avec les caracteres numeriques du textbox
Private Sub TextBox1_Change()
chaine = ""
For i = 1 To Len(TextBox1)
If IsNumeric(Mid(TextBox1, i, 1)) Then chaine = chaine & Mid(TextBox1, i, 1) 'si le caractere est numerique on l'ajoute a la chaine
If Len(chaine) = 3 Or Len(chaine) = 6 Or Len(chaine) = 9 Then chaine = chaine & " "
Next 'fin de boucle
 
If Len(chaine) > 12 Then chaine = Left(chaine, 12) 'on bloque la chaine a 12 caractere espaces compris
'si la chaine numerique n'a pas encore les 9 chiffres on ajoute la partie correspondante de la chaine vide
TextBox1 = chaine & Mid(chainevide, Len(chaine) + 1, 12 - Len(chaine) + 1)
' on place le curseur
TextBox1.SelStart = pointeur
End Sub
 
 
Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'si l'on double clic le groupe de chiffre au niveau du curseur qui est separé des _
autres par un espace de chaque coté est selectionné en bleu
'avec la variable selection on va pouvoir gérer la fonction"TextBox1_KeyDown"
 
selection = True 'selection d'un groupe de chiffre
End Sub
 
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
 
Case "8" ' si on appuie sur la touche effacer
pointeur = TextBox1.SelStart - 1
If pointeur < 0 Then pointeur = 0
 
Case "46"
'si le curseur se trouve devant un espace il ne supprimera pas puisque les espace sont placé et ne doivent pas changer
' alors on decale le curseur de 1 caractere vers la droite
If Mid(TextBox1, TextBox1.SelStart + 1, 1) = " " Then
pointeur = TextBox1.SelStart + 1
'maintenant que le curseur se trouve devant le chiffre on supprime le chiffre a droite du curseur
TextBox1 = Replace(TextBox1, Mid(TextBox1, pointeur, 1), "")
Else
pointeur = TextBox1.SelStart
End If
 
Case 96, 97, 98, 99, 100, 101, 102, 103, 104, 105 ''si on appuie sur le pavé numérique de 0 a 9
' avant on a selectionner un groupe de chiffre par le double clic on bloque le curseur pour qu'il ne se deplace pas comme il devrait le faire
If selection = True Then pointeur = TextBox1.SelStart: selection = False
'si l'on est devant un espace on decale le curseur de 2(exemple :" 1" alors on place le curseur devant "1")
If Mid(TextBox1, TextBox1.SelStart + 1, 1) = " " Then
pointeur = pointeur + 2
Else
'autrementon decale simplement le curseur de 1 vers la droite
pointeur = pointeur + 1
End If
Case 106
'on vide le textbox la chaine vide se remettra automatiquement par le text_change
TextBox1 = ""
 
End Select
End Sub
'ET voila le tour est joué
'finalement les choses les plus simples restent les plus éfficaces

ca a l'air de rien mais j'ai quand meme bossé 4 heures la dessus
j'espere que ca te conviendra
au plaisir

[Ormonth]

il y a 8 jours .....

Envoyé par patricktoulon

bonjour a tous

sans vouloir blésser qui que ce soit
je trouve que c'est beaucoup pédaler pour un simple masque de saisie