Entrer un numéro de téléphone dans une zone de texte

**Docmarti** · 27/08/2018, 00h21

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
110
111
112
113
114
115
116
117
118
119
120
121
Option Explicit
Public separ
 
Private Sub ComboBox1_Click()
 
Select Case ComboBox1.ListIndex
 Case 0: separ = " "
 Case 1: separ = "-"
End Select
 
End Sub
 
Private Sub TextBox1_Enter()
 TextBox1.Value = DefinirFormatAffichage(TextBox1.Value)
End Sub
 
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
 TextBox1.Value = Trim(DefinirFormatAffichage(TextBox1.Value))
End Sub
 
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Dim debut As String, fin As String
Dim SelStart As Long
Dim tout As String
Dim nbr As Long
Dim i As Long
Dim caract
caract = "0123456789"
If InStr(caract, Chr(KeyAscii)) = 0 Then KeyAscii = 0: Exit Sub
SelStart = TextBox1.SelStart
debut = Mid(TextBox1.Text, 1, SelStart) & Chr(KeyAscii)
fin = Mid(TextBox1.Text, SelStart + 1)
tout = debut & fin
 
'KeyAscii = 0
 
TextBox1.Value = DefinirFormatAffichage(tout)
 
Dim N As Long
 N = CombienDeCaractAvantSelStart(debut)
'Placer SelStart apres N caracteres
 nbr = 0
 TextBox1.SelStart = 0
 If N > 0 Then
 For i = 1 To Len(TextBox1.Value)
  TextBox1.SelStart = TextBox1.SelStart + 1
  If Mid(TextBox1.Value, i, 1) <> separ Then
   nbr = nbr + 1
  End If
  If nbr = N Then
   Exit For
  End If
Next
 
If Right(TextBox1.Value, 1) = separ Then
 
 TextBox1.SelStart = TextBox1.SelStart + 1
End If
End If
 KeyAscii = 0
End Sub
 
Function DefinirFormatAffichage(ByVal txt As String)
Dim a As String
Dim f As String
Dim nbr As Long
Dim i As Long
Dim m As String
Dim caract
caract = "0123456789"
a = ""
For i = 1 To Len(txt)
 m = Mid(txt, i, 1)
 If InStr(caract, m) Then
  a = a & m
 End If
Next
 
 f = ""
 nbr = 0
 For i = 1 To Len(a)
  m = Mid(a, i, 1)
  f = f & m
  nbr = nbr + 1
 Select Case ComboBox1.ListIndex
  Case 1
  If nbr = 3 Or nbr = 6 Then f = f & separ
  Case 0
  If nbr = 2 Or nbr = 4 Or nbr = 6 Or nbr = 8 Then f = f & separ
 End Select
 Next
DefinirFormatAffichage = f
End Function
 
Function CombienDeCaractAvantSelStart(ByVal debut)
Dim N As Long
Dim i As Long
 
N = 0
 
For i = 1 To Len(debut)
 If Mid(debut, i, 1) = separ Then
 Else
 N = N + 1
 End If
Next
CombienDeCaractAvantSelStart = N
End Function
 
Private Sub CommandButton1_Click()
Dim c As Range
Set c = Cells(1, 1)
c.Value = "'" & DefinirFormatAffichage(TextBox1.Value)
End Sub
 
Private Sub UserForm_Initialize()
ComboBox1.AddItem "Francais"
ComboBox1.AddItem "Americain"
ComboBox1.ListIndex = 0
 
End Sub

**Docmarti** · 31/08/2018, 19h08

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
Option Explicit
Dim CodeInput
Dim pays
Dim codeVerif
Dim caract
 
Sub NouveauNumero()
    Call formater("", "")
End Sub
 
Private Sub ComboBox1_Click()
    TextBox1.Value = ""
    pays = Trim(ComboBox1.List(2))
    codeVerif = ComboBox1.List(ComboBox1.ListIndex, 2)
    Call NouveauNumero
 
End Sub
 
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 13 Then
        KeyCode = 0
        SauvegarderLaValeur
    End If
End Sub
 
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Dim selstart
    Dim debut
    Dim fin
    selstart = TextBox1.selstart
    debut = Mid(TextBox1.Value, 1, selstart) & Chr(KeyAscii)
    fin = Mid(TextBox1.Value, selstart + 1)
    fin = Replace(fin, "_", CodeInput)
    Call formater(debut, fin)
    KeyAscii = 0
End Sub
 
Sub formater(debut, fin)
    Dim memdebut
    Dim memfin
    Dim i, f, b, m, nbr, a
    Dim tout
    Dim selstart
    Dim traitedebut
    Dim nbrfin
    Dim nbrdebut
    debut = nettoie(debut)
    fin = nettoie(fin)
    tout = debut & fin
    memdebut = debut
    memfin = fin
    f = ""
    traitedebut = True
    nbrdebut = 0
    nbrfin = 0
    For i = 1 To Len(codeVerif)
        m = Mid(codeVerif, i, 1)
        If m <> "&" Then
            f = f & m
        Else
            If memdebut <> "" Then
                f = f & Mid(memdebut, 1, 1)
                selstart = Len(f)
                memdebut = Mid(memdebut, 2)
            Else
                If memfin = "" Then
                    f = f & "_"
                Else
                    f = f & Mid(memfin, 1, 1)
                    memfin = Mid(memfin, 2)
                End If
            End If
        End If
    Next
 
    TextBox1.Value = f
    TextBox1.selstart = selstart
 
    While Mid(codeVerif, TextBox1.selstart + 1, 1) <> "&" And TextBox1.selstart < Len(codeVerif)
        TextBox1.selstart = TextBox1.selstart + 1
    Wend
    TextBox1.SetFocus
End Sub
 
Function nettoie(txt)
    Dim i, chiffres
    chiffres = ""
    For i = 1 To Len(txt)
        If InStr(caract, Mid(txt, i, 1)) = 0 Then
        Else
            chiffres = chiffres & Mid(txt, i, 1)
        End If
    Next
    nettoie = chiffres
End Function
 
Function SauvegarderLaValeur()
    Dim valeur
    Dim c As Range
    Dim i
    Call formater(TextBox1.Value, "")
    If Trim(codeVerif) <> "" Then
        If Len(Trim(TextBox1.Value)) <> Len(Trim(codeVerif)) Then
            Beep
            Exit Function
        End If
    End If
    For i = 1 To Len(codeVerif)
        If Mid(codeVerif, i, 1) = CodeInput Then
            If InStr(caract, Mid(TextBox1.Value, i, 1)) = 0 Then
                Beep
                Exit Function
            End If
        End If
    Next
    'Ecrire sur la feuille
    Set c = Cells(Rows.Count, "A").End(xlUp).Offset(1)
    c.Value = "'" & TextBox1.Value
    Call NouveauNumero
End Function
 
Private Sub UserForm_Initialize()
    Dim Lastlig
    CodeInput = "&"
    caract = "0123456789"
 
    TextBox1.MultiLine = True
    With ComboBox1
        .ColumnCount = 3
        .ColumnWidths = "100;20;250"
    End With
    With Me.TextBox1
        .Font.Bold = True
        .Font.Size = 14
        .Enabled = True
    End With
    Lastlig = Sheets("Feuil3").Cells(Rows.Count, "a").End(xlUp).Row 'dernière ligne
    Me.ComboBox1.RowSource = "Feuil3!A2:C" & Lastlig
    ComboBox1.ListIndex = -1
End Sub

Exemples de formats telephoniques
A copier dans Sheets("Feuil1").Range("A1")

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
A	B	C
Suède 		& && && &&&
Autriche 		& &&& &&&
Guadeloupe 		&& && &&
Danemark 		&& && && &&
France 		&& && && && &&
Pologne 		&& &&& && &&
Finlande 		&& &&& &&&&
Bresil 		&& &&&&-&&&&
Liechtenstein 		&&& && &&
Russie 		&&& &&& && &&
Portugal 		&&& &&& &&&
Italie 		&&& &&& &&&&
Slovaquie 		&&& &&&&&&
Albanie 		&&&& &&&&
Canada 		&&&-&&&-&&&&
Espagne 		&&&.&&.&&.&&
Chine1 		&&.&&&&.&&&&
Hong Kong 		&&.&&.&&.&&
Etats-Unis 		(&&&) &&&-&&&&
Iran 		(&&) && && && &&

**Docmarti** · 03/09/2018, 18h28

Version epuree

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
110
111
112
113
114
115
116
117
118
119
Option Explicit
Dim CodeInput
Dim pays
Dim codeVerif
Dim caract
 
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Dim selstart
    Dim debut
    Dim fin
    selstart = TextBox1.selstart
    debut = Mid(TextBox1.Value, 1, selstart) & Chr(KeyAscii)
    fin = Mid(TextBox1.Value, selstart + 1)
    fin = Replace(fin, "_", CodeInput)
    Call formater(debut, fin)
    KeyAscii = 0
End Sub
 
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Dim c As Range
    If KeyCode = 13 Then
        KeyCode = 0
        Call formater(TextBox1.Value, "") 
       If InStr(TextBox1.Value, "_") Then
        Beep
        Exit Sub
       End If
        Set c = Worksheets("Feuil1").Cells(1, 1)
        c.Value = "'" & TextBox1.Value
        Call formater("", "")
    End If
End Sub
 
Private Sub ComboBox1_Change()
    TextBox1.Value = ""
    pays = Trim(ComboBox1.List(2))
    codeVerif = ComboBox1.List(ComboBox1.ListIndex, 2)
    Call formater("", "")
End Sub
 
Function formater(debut, fin)
    Dim memdebut
    Dim memfin
    Dim i, f, b, m, nbr, a
    Dim tout
    Dim selstart
    Dim nbrfin
    Dim nbrdebut
 
    debut = nettoie(debut)
    fin = nettoie(fin)
    tout = debut & fin
    memdebut = debut
    memfin = fin
    f = ""
    nbrdebut = 0
    nbrfin = 0
    For i = 1 To Len(codeVerif)
        m = Mid(codeVerif, i, 1)
        If m <> "&" Then
            f = f & m
        Else
            If memdebut <> "" Then
                f = f & Mid(memdebut, 1, 1)
                selstart = Len(f)
                memdebut = Mid(memdebut, 2)
            Else
                If memfin = "" Then
                    f = f & "_"
                Else
                    f = f & Mid(memfin, 1, 1)
                    memfin = Mid(memfin, 2)
                End If
            End If
        End If
    Next
 
    TextBox1.Value = f
    TextBox1.selstart = selstart
 
    While Mid(codeVerif, TextBox1.selstart + 1, 1) <> "&" And TextBox1.selstart < Len(codeVerif)
        TextBox1.selstart = TextBox1.selstart + 1
    Wend
    TextBox1.SetFocus
End Function
 
Function nettoie(txt)
    Dim i, chiffres
    chiffres = ""
    For i = 1 To Len(txt)
        If InStr(caract, Mid(txt, i, 1)) = 0 Then
        Else
            chiffres = chiffres & Mid(txt, i, 1)
        End If
    Next
    nettoie = chiffres
End Function
 
Private Sub UserForm_Initialize()
    Dim Lastlig
 
    CodeInput = "&"
    caract = "0123456789"
 
    With ComboBox1
        .ColumnCount = 3
        .ColumnWidths = "100;20;250"
    End With
    Lastlig = Sheets("Feuil3").Cells(Rows.Count, "a").End(xlUp).Row 'dernière ligne
    Me.ComboBox1.RowSource = "Feuil3!A2:C" & Lastlig
    ComboBox1.ListIndex = -1
 
    With Me.TextBox1
        .Font.Bold = True
        .Font.Size = 14
        .Enabled = True
    End With
    TextBox1.MultiLine = True
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
A	B	C
France 		&& && && && &&
Russie 		&&& &&& && &&
Etats-Unis 		(&&&) &&&-&&&&
Canada 		&&&-&&&-&&&&
Espagne 		&&&.&&.&&.&&
Autriche 		& &&& &&&
Albanie 		&&&& &&&&
Liechtenstein 		&&& && &&
Portugal 		&&& &&& &&&
Italie 		&&& &&& &&&&
Finlande 		&& &&& &&&&
Danemark 		&& && && &&

**Docmarti** · 05/09/2018, 14h33

Plus simple.
Et utilise ComboBox1.List = t.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
110
111
112
113
114
115
116
117
118
119
120
121
122
Option Explicit
Dim caracteres
Dim codePays
Dim CodeInput
 
Sub ListeVersCombobox()
Dim N
Dim t(3, 1)
N = -1
N = N + 1: t(N, 1) = "&& && && && &&": t(N, 0) = "France":
N = N + 1: t(N, 1) = "&&& &&& && &&": t(N, 0) = "Russie":
N = N + 1: t(N, 1) = "(&&&) &&&-&&&&": t(N, 0) = "Etats-Unis":
N = N + 1: t(N, 1) = "&&&-&&&-&&&&":   t(N, 0) = "Canada":
ComboBox1.List = t
End Sub
 
Private Sub ComboBox1_Click()
TextBox1.Value = ""
    codePays = ComboBox1.List(ComboBox1.ListIndex, 1)
    UserForm4.Caption = ComboBox1.List(ComboBox1.ListIndex, 0)
    Call formater("", "")
End Sub
 
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Dim debut, fin
    If InStr(caracteres, Chr(KeyAscii)) > 0 Then
    debut = Mid(TextBox1.Value, 1, TextBox1.selstart) & Chr(KeyAscii)
    fin = Mid(TextBox1.Value, TextBox1.selstart + 1)
    fin = Replace(fin, "_", CodeInput)
    Call formater(debut, fin)
    End If
    KeyAscii = 0
End Sub
 
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Dim c As Range
    If KeyCode = 13 Then
    'Ecriture sur feuille
        KeyCode = 0
        Call formater(TextBox1.Value, "")
        If InStr(TextBox1.Value, "_") Then
         Beep
        Exit Sub
       End If
       Set c = Worksheets("Feuil1").Cells(1, 1)
       c.Value = "'" & TextBox1.Value
       Call formater("", "")
    End If
End Sub
 
Function formater(debut, fin)
    Dim memdebut
    Dim memfin
    Dim memSelstart
    Dim f, i, m
 
    debut = LesChiffres(debut)
    fin = LesChiffres(fin)
    memdebut = debut
    memfin = fin
    memSelstart = 0
    f = ""
 
    For i = 1 To Len(codePays)
        m = Mid(codePays, i, 1)
        If m <> "&" Then
            f = f & m
        Else
            If memdebut <> "" Then
                f = f & Mid(memdebut, 1, 1)
                memdebut = Mid(memdebut, 2)
                memSelstart = Len(f)
            Else
                If memfin = "" Then
                    f = f & "_"
                Else
                    f = f & Mid(memfin, 1, 1)
                    memfin = Mid(memfin, 2)
                End If
            End If
        End If
    Next
 
    TextBox1.Value = f
    TextBox1.selstart = memSelstart
 
    While Mid(codePays, TextBox1.selstart + 1, 1) <> "&" And TextBox1.selstart < Len(codePays)
        TextBox1.selstart = TextBox1.selstart + 1
    Wend
    TextBox1.SetFocus
End Function
 
Function LesChiffres(txt)
    Dim i
    For i = 1 To Len(txt)
        If InStr(caracteres, Mid(txt, i, 1)) = 0 Then
 
        Else
            LesChiffres = LesChiffres & Mid(txt, i, 1)
        End If
    Next
End Function
 
Private Sub UserForm_Initialize()
    caracteres = "0123456789"
    CodeInput = "&"
 
 With Me.TextBox1
        .Font.Bold = True
        .Font.Size = 14
        .Enabled = True
    End With
    TextBox1.MultiLine = True
 
    With ComboBox1
        .ColumnCount = 2
        .ColumnWidths = "80;40"
        .Style = 0
    End With
    Call ListeVersCombobox
    ComboBox1.ListIndex = -1
End Sub

**Pierre Fauconnier** · 14/09/2018, 07h52

Salut.

En Belgique, on peut avoir les formats suivants (je pense aux plus courants):

+32 ## ## ## ##;
+32 ### ## ## ##;
+32 # ### ## ##;
+32 ## ### ###;

Si on ne met pas le préfixe international, on peut aussi avoir:

0### ## ## ##;
0### ### ###;
0# ### ## ##;

Et il y en a d'autres.

Je doute sincèrement de la pertinence d'une validation de format en fonction du pays et perso, ça m'énerverait assez de me faire guider à ce niveau et de me voir refuser un format parce qu'un algorithme ne l'a pas prévu...

**Docmarti** · 21/09/2018, 02h38

Envoyé par Pierre Fauconnier

Je doute sincèrement de la pertinence d'une validation de format en fonction du pays et perso, ça m'énerverait assez de me faire guider à ce niveau et de me voir refuser un format parce qu'un algorithme ne l'a pas prévu...

Salut Pierre.
Merci pour ta reponse.
Ccomme tu le dis, il y a plusieurs pays, tels la Belgique, la Chine, etc qui n'ont pas uniformise leurs nombreux formats de numeros de telephone. Mon but n'est pas de
fournir une liste de tous les formats de tous ces pays. C'est plutot de fournir une liste facilement modifiable que chacun pourra completer et adapter a ses besoins.

Mon but est avant tout d'offrir un algorithme simple et fonctionnel facilitant l'entree de numeros de telephone dans un format qui peut etre personnalise grace a la possibilite d'ajouter ses propres formats ou meme de modifier les formats deja proposes dans le classeur ci-joint.

Entree_NumerosDeTelephones_013.zip

Entrer un numéro de téléphone dans une zone de texte

Contribuez

Discussions similaires

Partager

Partager