Autres Masque de saisie universel pour formats spéciaux saisis dynamiquement dans un TextBox

[Eric C]

Bonsoir le forum

De très nombreux sujets ont trait aux formats spéciaux saisis à l'aide d'une TextBox (N° d'immatriculation de véhicules – N° SIRET de société – N° de sécurité sociale – N° spéciaux de téléphone étrangers…….).

Une demande, faite en 2018, par notre ami Cathodique concernait la saisie dynamique d'un N° SIRET Entreprise (Le lien ). Des réponses fournies, j'ai remarqué que celle de notre ami job75 , pouvait être aisément reprise et aménagée pour d'autre types de formats.

A cet effet, j'ai "déterré" ledit post qui avait été vu par quelques 650 internautes, à l'époque, en demandant si la saisie jusqu'alors uniquement numérique pouvait être modifiée afin de devenir saisie alphanumérique et ce afin d'élargir la saisie à d'autres formats spéciaux .

Est arrivé notre ami patricktoulon , qui nous a sorti de sa besace le fichier par EXCELlence : Un masque de saisie universel pour une grande partie des formats spéciaux (Post vu ~ 250 fois).

Ma question : peut-on améliorer le fichier afin de saisir des caractères alphanumériques incluant des ponctuations, des chiffres ainsi que des lettres Majuscules & Minuscules. Un grand Merki par anticipation.

Bonne soirée & bon ouikand à toutes & à tous
@+ Eric c

 

[patricktoulon]

re
bonjour
bon ben nous voila enfin dans un post dédie a cette méthode voila une chose de bien

alors question
tout en majuscule ou c'est aléatoire?
dans le cas de tout en majuscule on change rien on fait un ucase

dans le cas ou c'est aléatoire
avec keydown il faudra utilise l'api getkeystate

sinon
on fera la même chose mais dans l’événement keypress ou le keyascii donne le maj ou le min
mais on perd la navigation car keypress ne gère pas les touche back,suppr,fleches droite et gauche

il faudra alors utiliser les deux événements
c'est le travail que j'ai eu quand j'ai créé cette méthode avec masque de saisie

donc décide toi et je te ferait la version qui te convient

ça tombe bien ca me permet de revoir un peu ce truc (ca commence a dater)et voir si je peux ou trouver un moyen me passer de l'api et ainsi garder keydown comme ca tout sera toujours géré par q'un seul événement
j'ai déjà quelques idées

 

[Eric C]

Bonjour le forum
Bonjour Patrick

Merci beaucoup d'être revenu sur ce new fil.
Comme je le laissais sous-entendre, ce post intéresse de nombreuses personnes alors si tu es d'accord (j'ai bien lu que tu l'étais), je désirerais la seconde version.
Pour info, j'avais résolu le problème des majuscules avec soit en sortie

 Case 13:    [A1] = UCase(Tsiret)

soit lors de la saisie dynamique (merci pour l'annotation du code)

Tsiret = UCase(txt): Tsiret.SelStart = IIf(InStr(1, Tsiret, "X") = 0, s + 1, InStr(1, Tsiret, "X") - 1)

.
D'avance grand merci & bon ouikand à toi ainsi qu'à toutes & à tous
@+ Eric c

 

[patricktoulon]

bon j'aime pas trop le titre de ton post ce me donne l'impression d'un travail inachevé alors que ca fonctionne tres bien

bon ucase c'est bien mais alors demain tu a besoins de ca pour un autre textbox et autre format tu es obligé de modifier le code
d'autant plus que si tu a besoins des min et des maj dans la chaîne ben tu es chocolat
il etait donc pour moi clair que je devais tout simplement rendre a cesar ce qui est a cesar c'est a dire rendre au clavier ses touches Maj et verrMaj
alors pour la touche Verr Maj qui est fixe ca n'a pas été difficile mais pour la touche Maj qui est volatile j'ai du me résigner a utiliser le keydown
donc
nous voila avec un editformatbox qui gere les deux touches Majuscules

Option Explicit
Private Sub Tsiret_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    'MsgBox KeyCode
    Dim Mask$, txt$, s&, longg&, plus&
    Mask = "XXX / XXX XX XX"
       If Tsiret = "" And KeyCode <> 8 And KeyCode <> 46 Then Tsiret = Mask
    txt = Tsiret.Value:    If txt = Mask Then Tsiret.SelStart = 0
    s = Tsiret.SelStart:
    longg = Tsiret.SelLength: If longg = 0 Then longg = 1
    plus = IIf(KeyCode < 96, 32, -48):
    Select Case KeyCode
    Case 96 To 105, 65 To 90
        If s = Len(Mask) Then KeyCode = 0: Exit Sub
        If Mid(Mask, s + 1, 1) <> "X" Then KeyCode = 0: s = s + 1: Tsiret.SelStart = s: Exit Sub
        Mid(txt, s + 1, longg) = IIf(Val(Tsiret.Tag) = 0, Chr(KeyCode + plus), UCase(Chr(KeyCode + plus))) & Mid(Mask, s + 2, longg - 1): KeyCode = 0 'new!!!
        Tsiret = txt: Tsiret.SelStart = IIf(InStr(1, Tsiret, "X") = 0, s + 1, InStr(1, Tsiret, "X") - 1)
    Case 8
        If s <> 0 Then Mid(txt, s, longg + 1) = Mid(Mask, s, longg + 1) Else Exit Sub
        Tsiret = txt: Tsiret.SelStart = s - 1: KeyCode = 0
        If txt = Mask Then Tsiret = ""
    Case 46
        If Tsiret = "" Then Exit Sub
        If longg = 0 Then longg = 1
        Mid(txt, s + 1, longg) = Mid(Mask, s + 1, longg)
        Tsiret = txt: Tsiret.SelStart = s: KeyCode = 0
        If txt = Mask Then Tsiret = ""

    Case 39: Tsiret.SelStart = s + 1
    Case 37: Tsiret.SelStart = s - IIf(s > 0, 1, 0)
    Case 20: If Val(Tsiret.Tag) = 0 Then Tsiret.Tag = 1 Else Tsiret.Tag = 0'  new!!! touche verr Maj
    Case 16:  Tsiret.Tag = 1'   new!!! touche Maj
    
    Case 13:    ' touche enter  fait ce que tu veux c'est la sortie
    Case Else: KeyCode = 0
    End Select
End Sub
'                                            new!!!'
'gestion du relâchement de la touche Maj
Private Sub Tsiret_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 16 Then Tsiret.Tag = 0
End Sub

voila c'est plus dans le cadre de mon projet universel que le ucase forcé

et pour le coup on ne passe pas par keypress


oserais je ajouter que au départ c’était pour un editbox numerique et donc le caractères du mask"X" n’était pas un problème
je te suggère donc de réfléchir toi qui a besoins des lettres (que va t il se passer quand tu aura besoins du "X" )
je sais c'est marrant non ?

voyons voir si tu a compris le principe

que faudra t il faire ???????

 

[Eric C]

Re. Déjà à pied d'oeuvre. Tu ne dors pas beaucoup ?

Le Ucase servait évidemment que pour les saisies en Majuscules. Il est bien évident que Toutes les lettres étaient converties.
Concernant les "X", il est vrai que je n'avais pas vu le problème sous cet angle (d'ailleurs je ne l'avais pas vu du tout)
Peut on contourner ce problème en remplaçant les "X" par des "_" ? Oui, j'ai essayé, cela fonctionne mais ce n'est pas agréable visuellement lors de la saisie car l'on ne voit pas de séparatifs dans les groupes. Ton interrogation me laisse présumer que Tu as la réponse à ce problème !
J'apprécie cette lecture et ton travail de fond (et de forme également).
P.s : j'essaierai ton nouveau code dès mon retour.

 

[patricktoulon]

ben oui le caractère du mask doit être suffisamment explicit visuellement et suffisamment éloigné du jeu des 26 +10 caractères(num/lettres)
l’astérisque est celui le plus approprié c'est d’ailleurs pour ca que le password l'utilise
il est visuel et rare en utilisation comme caractères il est d'ailleurs aussi utilisé dans diverses fonction vba
quand je ferais la fonction généralisé externe a l’événement textbox je le mettrais en argument
j'attend encore un peu au cas ou il y aurais une idée intéressante a intégrer

je suis sur la navigation aujourd'hui je me tate a remettre les flèche de navigation a jumper segment par segments au lieu de caractères par caractères comme dans mon datebox

 

[eriiic]

Bonjour,

mon apport sera modeste, juste des questionnements
Les caractères du masque ne pourraient-ils pas montrer ce qui est attendu ?
Par exemple :
0 : un numérique 0-9
A : majuscule
a : minuscule
? : majuscule ou minuscule
plus éventuellement (ça risque de compliquer le code et surtout la compréhension du masque) un caractère joker pour en imposer un spécifique en cas de besoin. Par analogie avec les formats personnalisés ça pourrait être le \
Ce qui donnerait par exemple :
Mask = "\AAA / 000 00-00"
doit commencer par "A" qui ne serait pas à saisir comme le /, le - et les espaces
eric

 

[patricktoulon]

RE
j'y avais pensé ca ca sera pour la version mask anonyme

en attendant est tu prés pour l’extériorisation de l’événement

et tu prêt pour des mask avec caractères fixes(préfixe,suffixe,partoffstring)

je m'amuse comme un fou avec ce truc

donc avec la même sub

c'est bien quand c'est universel non?
le toulonnais fait mu muse

 

[job75]

Bonjour Eric C, patricktoulon, eriiiic,

Voyez le fichier joint et ce code, très simple :

Private Sub TextBox1_GotFocus()
TextBox1_Change
End Sub

Private Sub TextBox1_Change()
Dim x$, t$, i%, j%, pos%
x = "- -- -- -- --- --- --" 'masque de saisie avec tirets et espaces
t = Replace(Replace(TextBox1, "-", ""), " ", "")
For i = 1 To Len(t)
    For j = j + 1 To Len(x)
        If Mid(x, j, 1) = "-" Then
            x = Left(x, j - 1) & Mid(t, i, 1) & Mid(x, j + 1)
            pos = j
            Exit For
        End If
Next j, i
If Mid(x, pos + 1, 1) = " " Then pos = pos + 1
TextBox1 = x
TextBox1.SelStart = pos
TextBox1.SelLength = 1
End Sub

A+

 

[job75]

Dans ce fichier (2) le masque de saisie est composé de tirets bas (non visibles) et d'espaces.

 

[patricktoulon]

c'est pas mal job75
la touche suppr ramène ce qui est après suppression
est il possible d'avoir plusieurs séparateurs differents ?

1. bon la double boucle imbriquée j'avoue je suis pas fan
2. n'y aurais t il pas moyen avec instr(1,selstart +1 à reste du len) de chopper le next mask'characteres
3. le revient sur une position n'est pas géré non plus il insère et non remplace
4. un caractere tapé sur une selection de plusieurs carets supprime le nombre de caractères sélectionnes -1 et recule le reste

mais je garde voir si je peux faire péter les boucles
edit:
bon ben j'en ai fait sauter une

Option Explicit

Private Sub TextBox1_GotFocus()
    TextBox1_Change
End Sub

Private Sub TextBox1_Change()
    Dim x$, t$, i%, j%, pos%
    x = "- -- -- -- --- --- --"    'masque de saisie avec tirets et espaces
    t = Replace(Replace(TextBox1, "-", ""), " ", "")
    For i = 1 To Len(t)
        pos = InStr(x, "-")
        If pos <> 0 Then Mid$(x, pos, 1) = Mid$(t, i, 1)
    Next i
    TextBox1 = x
    TextBox1.SelStart = pos + IIf(Mid$(TextBox1, TextBox1.SelStart + 1, 1) = " ", 1, 0)
    TextBox1.SelLength = 1
End Sub

c'est pas gagné pour le remplace avec un length =0 avec cette méthode mais je crois que l'on peut y arriver

mais au final je préfère ma méthode
if length=0 then length=1
mid(txt,start,length)=caractere tapé & mid(mask,start+1,length-1)
tu viens de me donner un os a ronger merci
EDIT2:
et non on peut pas c'est l’événement change donc caractères déjà inséré

 

[job75]

Bonjour le fil, le forum,

Pour l'effacement on peut éviter la touche Ctrl avec l'évènement KeyDown (KeyCode = 8), voyez ces fichiers (1 bis) et (2 bis).

Bon dimanche.

 

[patricktoulon]

re
bonjour job75 je ne vois pas le changement avec le premier mis a part peur être la touche ctrl
mais le problème reste entier la touche suppr ou back ramène ce qu'il y a après la sélection
alors que le but est de pouvoir réécrire la portion sélectionné
et sur l’événement change difficile d'anticiper dans le cadre d'un masque de saisie spécifique voir avec prefixe ou sufixe ou part off string
regarde le comportement souhaité Avec les touches back et suppr dans cet exemple

 

[job75]

bonjour job75 je ne vois pas le changement avec le premier mis a part peur être la touche ctrl

Ben oui, c'est bien ce que j'ai dit et fait au post #12...

Maintenant pour la touche suppr voyez ces fichier (1-3) et (2-3), la touche sélectionne un caractère pour qu'il soit ensuite remplacé :

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 8 Then retour = True: TextBox1_Change: retour = False
If TextBox1.SelLength < 2 Then If KeyCode = 46 Then KeyCode = 0: TextBox1.SelLength = 1 'touche suppr
End Sub

 

[job75]

On peut aussi utiliser le double-clic, fichiers (1-4) et (2-4) :

Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Cancel = True
TextBox1.SelLength = 1
End Sub