XL 2010 Masque de saisie textbox Téléphone Public

cathodique

cathodique

XLDnaute Barbatruc
Bonsoir,

J'utilise le code ci-dessous de @patricktoulon pour saisir des numéros de téléphone dans une textbox.
Son code est dans une procédure Private, elle s’exécute parfaitement dans le formulaire où elle se trouve.
VB: 
'********************************************************************
'COLLECTION TEXTBOX FORMATE EPISODE 1 EXERCICE 1                    *
'         UN phonnebox FR avec masque de saisie                     *
'en version simplifié a but école                                   *
'auteur patricktoulon sur exceldownload et excel pratique           *
'version 3.7                                                        *
'                                                                   *
'le moteur séparé de l'event pour utilisation multi textbox         *
'********************************************************************
Option Explicit
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Dim X&, Xl&, D&, M&, A, T$, mask: mask = "__ __ __ __ __"
    'pour ceux qui n'ont pas le pavé numerique conversion du keycode du pavé haut du clavier(Attention!!!pas besoins de bloquer la touche MAJ!!!!!!!!le code se charge de convertir)
    If KeyCode >= 48 And KeyCode <= 57 Then KeyCode = KeyCode + 48
    'c'est parti on démarre le controle!!
    With TextBox1
        Xl = .SelLength: If Xl = 0 Then Xl = 1    'Xl= la longeur de texte selectionné
        .Value = IIf(.Value = "", mask, .Value): If KeyCode = 8 And Xl > 1 Then KeyCode = 46
        T = .Value: .SelStart = IIf(T = mask, 0, .SelStart): X = .SelStart:
        Select Case KeyCode
        Case 96 To 105  'pavé numerique haut et bas
            If X = 14 Then KeyCode = 0: Exit Sub
            If X = 2 Or X = 5 Or X = 8 Or X = 11 Then X = X + 1
            Mid(T, X + 1, Xl) = Chr(KeyCode - 48) & Mid(mask, X + 2, Xl - 1)
            X = X + 1: Xl = 0: If X = 2 Or X = 5 Or X = 8 Or X = 11 Then X = X + 1
            KeyCode = 0
        Case 8:
            If X = 0 Then KeyCode = 0:: .Value = "": Exit Sub
            Mid(T, X, 1) = Mid(mask, X, 1): X = X - 1: Xl = 0: If T = mask Then T = ""
            KeyCode = 0    ' on annule toujours la touche
        Case 46:
            If X = 14 Then KeyCode = 0: Exit Sub
            Mid(T, X + 1, Xl) = Mid(mask, X + 1, Xl): X = X: Xl = Xl - 1: If T = mask Then T = ""
            KeyCode = 0    ' on annule toujours la touche
        Case Else
            KeyCode = 0
        End Select
        .Value = T 'restitution
        .SelStart = X: .SelLength = Xl
        KeyCode = 0
    End With
End Sub
Je l'ai copie dans un module standard mais ne fonctionne pas.
En effet, je voudrais réutiliser cette macro pour d'autres userforms.
En vous remerciant par avance.

Bonne soirée.
 
Solution
patricktoulon
re
Bonsoir
ben c'est simple
exemple 3 textbox dans un userform auront la même sub
VB: 
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
TextBox_KeyDown TextBox1, KeyCode
End Sub

Private Sub TextBox7_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
TextBox_KeyDown TextBox7, KeyCode
End Sub

Private Sub TextBox10_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
TextBox_KeyDown TextBox10, KeyCode
End Sub
dans un module standard
Code: 
'********************************************************************
'COLLECTION TEXTBOX FORMATE EPISODE 1 EXERCICE 1                    *
'         UN phonnebox FR avec masque de saisie                     *
'en...
Trier par date Trier par votes
cathodique

cathodique

XLDnaute Barbatruc
Staple1600 à dit:
Bonsoir @cathodique , le fil

Puisque Userform, le code VBA doit être dans le code de l'Userform et non pas dans un module standard.
Cliquez pour agrandir...
Tel qu'il est, je suis d'accord avec toi. Le code doit être dans le module de L'userform.

N'y a-t-il pas un moyen, en s'inspirant du code de @patricktoulon ou pas, pour faire une procédure public que l'on puisse appeler de n'importe quel textbox de n'importe quel userform?

Merci.

Bonne soirée.
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
Bonsoir
ben c'est simple
exemple 3 textbox dans un userform auront la même sub
VB: 
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
TextBox_KeyDown TextBox1, KeyCode
End Sub

Private Sub TextBox7_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
TextBox_KeyDown TextBox7, KeyCode
End Sub

Private Sub TextBox10_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
TextBox_KeyDown TextBox10, KeyCode
End Sub
dans un module standard
Code: 
'********************************************************************
'COLLECTION TEXTBOX FORMATE EPISODE 1 EXERCICE 1                    *
'         UN phonnebox FR avec masque de saisie                     *
'en version simplifié a but école                                   *
'auteur patricktoulon sur exceldownload et excel pratique           *
'version 3.7                                                        *
'                                                                   *
'le moteur séparé de l'event pour utilisation multi textbox         *
'********************************************************************
Option Explicit
Public Sub TextBox_KeyDown(ByRef Textbox As MSForms.Textbox, ByVal KeyCode As MSForms.ReturnInteger)
    Dim X&, Xl&, D&, M&, A, T$, mask: mask = "__ __ __ __ __"
    'pour ceux qui n'ont pas le pavé numerique conversion du keycode du pavé haut du clavier(Attention!!!pas besoins de bloquer la touche MAJ!!!!!!!!le code se charge de convertir)
    If KeyCode >= 48 And KeyCode <= 57 Then KeyCode = KeyCode + 48
    'c'est parti on démarre le controle!!
    With Textbox
        Xl = .SelLength: If Xl = 0 Then Xl = 1    'Xl= la longeur de texte selectionné
        .Value = IIf(.Value = "", mask, .Value): If KeyCode = 8 And Xl > 1 Then KeyCode = 46
        T = .Value: .SelStart = IIf(T = mask, 0, .SelStart): X = .SelStart:
        Select Case KeyCode
        Case 96 To 105  'pavé numerique haut et bas
            If X = 14 Then KeyCode = 0: Exit Sub
            If X = 2 Or X = 5 Or X = 8 Or X = 11 Then X = X + 1
            Mid(T, X + 1, Xl) = Chr(KeyCode - 48) & Mid(mask, X + 2, Xl - 1)
            X = X + 1: Xl = 0: If X = 2 Or X = 5 Or X = 8 Or X = 11 Then X = X + 1
            KeyCode = 0
        Case 8:
            If X = 0 Then KeyCode = 0:: .Value = "": Exit Sub
            Mid(T, X, 1) = Mid(mask, X, 1): X = X - 1: Xl = 0: If T = mask Then T = ""
            KeyCode = 0    ' on annule toujours la touche
        Case 46:
            If X = 14 Then KeyCode = 0: Exit Sub
            Mid(T, X + 1, Xl) = Mid(mask, X + 1, Xl): X = X: Xl = Xl - 1: If T = mask Then T = ""
            KeyCode = 0    ' on annule toujours la touche
        Case Else
            KeyCode = 0
        End Select
        .Value = T 'restitution
        .SelStart = X: .SelLength = Xl
        KeyCode = 0
    End With
End Sub
terminé
 
Vote positif 1 Vote négatif
Solution
cathodique

cathodique

XLDnaute Barbatruc
patricktoulon à dit:
re
Bonsoir
ben c'est simple
exemple 3 textbox dans un userform auront la même sub
VB: 
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
TextBox_KeyDown TextBox1, KeyCode
End Sub

Private Sub TextBox7_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
TextBox_KeyDown TextBox7, KeyCode
End Sub

Private Sub TextBox10_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
TextBox_KeyDown TextBox10, KeyCode
End Sub
dans un module standard
Code: 
'********************************************************************
'COLLECTION TEXTBOX FORMATE EPISODE 1 EXERCICE 1                    *
'         UN phonnebox FR avec masque de saisie                     *
'en version simplifié a but école                                   *
'auteur patricktoulon sur exceldownload et excel pratique           *
'version 3.7                                                        *
'                                                                   *
'le moteur séparé de l'event pour utilisation multi textbox         *
'********************************************************************
Option Explicit
Public Sub TextBox_KeyDown(ByRef Textbox As MSForms.Textbox, ByVal KeyCode As MSForms.ReturnInteger)
    Dim X&, Xl&, D&, M&, A, T$, mask: mask = "__ __ __ __ __"
    'pour ceux qui n'ont pas le pavé numerique conversion du keycode du pavé haut du clavier(Attention!!!pas besoins de bloquer la touche MAJ!!!!!!!!le code se charge de convertir)
    If KeyCode >= 48 And KeyCode <= 57 Then KeyCode = KeyCode + 48
    'c'est parti on démarre le controle!!
    With Textbox
        Xl = .SelLength: If Xl = 0 Then Xl = 1    'Xl= la longeur de texte selectionné
        .Value = IIf(.Value = "", mask, .Value): If KeyCode = 8 And Xl > 1 Then KeyCode = 46
        T = .Value: .SelStart = IIf(T = mask, 0, .SelStart): X = .SelStart:
        Select Case KeyCode
        Case 96 To 105  'pavé numerique haut et bas
            If X = 14 Then KeyCode = 0: Exit Sub
            If X = 2 Or X = 5 Or X = 8 Or X = 11 Then X = X + 1
            Mid(T, X + 1, Xl) = Chr(KeyCode - 48) & Mid(mask, X + 2, Xl - 1)
            X = X + 1: Xl = 0: If X = 2 Or X = 5 Or X = 8 Or X = 11 Then X = X + 1
            KeyCode = 0
        Case 8:
            If X = 0 Then KeyCode = 0:: .Value = "": Exit Sub
            Mid(T, X, 1) = Mid(mask, X, 1): X = X - 1: Xl = 0: If T = mask Then T = ""
            KeyCode = 0    ' on annule toujours la touche
        Case 46:
            If X = 14 Then KeyCode = 0: Exit Sub
            Mid(T, X + 1, Xl) = Mid(mask, X + 1, Xl): X = X: Xl = Xl - 1: If T = mask Then T = ""
            KeyCode = 0    ' on annule toujours la touche
        Case Else
            KeyCode = 0
        End Select
        .Value = T 'restitution
        .SelStart = X: .SelLength = Xl
        KeyCode = 0
    End With
End Sub
terminé
Cliquez pour agrandir...
Bonsoir @patricktoulon ;),

Rien à dire. Si ce n'est parfait pour moi.
ça va me permettre d'avancer.

Merci beaucoup.

Bonne soirée.
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
c'est pas l'exemple le plus recent ça
tu a pris ca sur ma ressource dans excel pratique

il y a un peu moins compliqué si tu veux
une des plus recente est celle ci
pareil la sub peut aller dans un module
VB: 
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Control_Keydown TextBox1, KeyCode
End Sub
Private Sub TextBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Control_Keydown TextBox2, KeyCode
End Sub





Sub Control_Keydown(ByRef textbox As MSForms.textbox, ByVal KeyCode As MSForms.ReturnInteger)
    Static mask$: Static m2$
    Dim sel&, x&
    If mask = "" Then mask = "__ __ __ __ __": m2 = mask
    If KeyCode >= 48 And KeyCode <= 57 Then KeyCode = KeyCode + 48
    With textbox
        x = .SelStart
        sel = .SelLength: If sel = 0 Then sel = 1
        Select Case KeyCode
        Case 96 To 105  'pavé numerique haut et bas
            If x = 14 Then KeyCode = 0: Exit Sub
            If Mid(mask, x + 1, 1) = " " Then x = x + 1: .SelStart = x
            Mid(mask, x + 1, 1) = Chr(KeyCode - 48): sel = 0
            .Value = mask: x = x + 1: If Mid(m2, x + 1, 1) = " " Then x = x + 1
        Case 8
            If x > 0 Then Mid(mask, x, 1) = Mid(m2, x, 1)
            x = x - 1: .Value = mask: If x < 0 Then x = 0
        Case 46
            Mid(mask, x + 1, sel) = Mid(m2, x + 1, sel): .Value = mask: sel = 1
       Case Else:keycode=0
 End Select
        .SelStart = x: .SelLength = sel: KeyCode = 0
    End With
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Bonsoir.
Juste une observation: si déjà on précise sa modalité de passage, un argument objet que la procédure n'est pas chargée d'initialiser par un Set à l'intention de la procédure appelante se passe normalement ByVal, non inutilement ByRef.
 
Vote positif 0 Vote négatif
cathodique

cathodique

XLDnaute Barbatruc
Dranreb à dit:
Bonsoir.
Juste une observation: si déjà on précise sa modalité de passage, un argument objet que la procédure n'est pas chargée d'initialiser par un Set à l'intention de la procédure appelante se passe normalement ByVal, non inutilement ByRef.
Cliquez pour agrandir...
Bonjour @Dranreb ;),

Là, je ne peux pas te répondre c'est le code de @patricktoulon.
Pour le moment, je n'ai pas atteint votre niveau pour "pondre" d'aussi complexes et compliqués codes.
Et, pourtant je fais des efforts mais beaucoup de choses sont floues pour moi.
Rien qu'à voir le nombre de bibliothèques dans les références, ça me donne le vertige.

Merci pour ta participation.

Bon dimanche
 
Vote positif 0 Vote négatif

Discussions similaires

A
  • Question
XL 2016 Combobox Saisie Date
Réponses
12
Affichages
543
aurelio.ewane
A
jcf6464
  • Résolu(e)
Microsoft 365 Saisie des / en automatique dans textbox date
Réponses
14
Affichages
590
jcf6464
jcf6464
halecs93
  • Résolu(e)
XL 2016 Indice n'appartient pas à la sélection : HELP !!!!
2
Réponses
21
Affichages
623
halecs93
halecs93
R
  • Question
XL 2021 Optimisation Code VBA
Réponses
10
Affichages
407
Dranreb
Dranreb
B
  • Résolu(e)
Microsoft 365 affecter des valeurs dans un tableau de noms de variable
Réponses
4
Affichages
442
bérylion
B
patricktoulon
  • Question
Autres Petite mise a jour (exceptionnellement pour cp4) du calendar V4.1(OLDVERSION)
2
Réponses
21
Affichages
506
patricktoulon
patricktoulon
R
  • Résolu(e)
XL 2016 Tabulation automatique entre deux textbox dans une feuille de calcul
Réponses
10
Affichages
664
ReneDav14000
R
N
  • Question
Microsoft 365 Imbrication de deux formule Worksheet_BeforeDoubleClick
Réponses
1
Affichages
163
Nathan027
N
L
  • Question
VBA : erreur sur boucle
Réponses
2
Affichages
98
Latias
L
Lu76Fer
  • Question
XL 2016 Démo pour positionner un UserForm ou ContextMenu sur la grille (Toute version)
10 11 12
Réponses
178
Affichages
5 K
TooFatBoy
TooFatBoy

Membres actuellement en ligne

Aucun membre en ligne actuellement.
0 membres et 51 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 379
Messages
2 087 767
Membres
103 662
dernier inscrit
rterterert