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

cathodique · 27 Avril 2024

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.

Staple1600 · 27 Avril 2024

Bonsoir @cathodique , le fil

Puisque Userform, le code VBA doit être dans le code de l'Userform et non pas dans un module standard.

cathodique · 27 Avril 2024

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.

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.

patricktoulon · 27 Avril 2024

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é

cathodique · 27 Avril 2024

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é

Bonsoir @patricktoulon

,

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

Merci beaucoup.

Bonne soirée.

patricktoulon · 27 Avril 2024

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

Dranreb · 27 Avril 2024

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.

cathodique · 28 Avril 2024

Bonjour @patricktoulon

,

patricktoulon à dit:
tu a pris ca sur ma ressource dans excel pratique

En effet, au fil de mes recherches via Google, j'ai abouti à tes ressources sur XLpratique.
Si ça fonctionne correctement, ça me convient.

Merci beaucoup.

Bon dimanche.

cathodique · 28 Avril 2024

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.

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

Effectuez une recherche sur Excel Downloads...

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

cathodique

XLDnaute Barbatruc

patricktoulon

Staple1600

XLDnaute Barbatruc

cathodique

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

cathodique

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

cathodique

XLDnaute Barbatruc

cathodique

XLDnaute Barbatruc

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums