Public Function MemeType(chaine As String, i As Long) As Boolean
    If IsNumeric(Mid(chaine, i, 1)) = IsNumeric(Mid(chaine, i - 1, 1)) Then
        MemeType = True
        Else
        MemeType = False
    End If
End Function
 

Public Function NumTel(Col As Range) As String
Dim chaine As String
Dim LenChaine As Long
Dim Pos1 As Long
Dim Pos2 As Long
Dim i As Long
Dim j As Long
Dim strlettre As String
Dim strnum As String
Dim varnum As Boolean
Dim veriftype As Boolean
Dim start As Long
chaine = Replace(Replace(Replace(Replace(Replace(Replace(Trim(Col), " ", ""), ".", ""), "/", ""), "*", ""), "+", ""), "-", "")
'MsgBox "la chaine: " & chaine
	If Len(chaine) >= 8 Then '1
		'MsgBox "Longueur Chaine: " & Len(chaine)
		strlettre = ""
		Pos1 = 1
		'MsgBox "Le Premier caractère de la chaine: " & Mid(chaine, Pos1, 1)
		'MsgBox "Est numérique premier caractere=" & IsNumeric(Mid(chaine, 1, 1))
	'For i = 2 To Len(chaine)
		i = 2
		Do While i < Len(chaine)
			'MsgBox "Boucle numéro " & i - 1
			'MsgBox "Caractere " & i & " = " & Mid(chaine, i, 1)
			'MsgBox "Est numérique " & i & " = " & IsNumeric(Mid(chaine, i, 1))
			'MsgBox "Est numérique " & i - 1 & " = " & IsNumeric(Mid(chaine, i - 1, 1))
			'MsgBox "Verif Type=" & MemeType(chaine, i)
			veriftype = MemeType(chaine, i)
				If veriftype = False Then '2
					Pos2 = i - 1
					'MsgBox "POsition de fin de chaine =" & Pos2
					'MsgBox "La chaine à considerer est-elle numérique ? = " & IsNumeric(Mid(chaine, Pos2, 1))
						If IsNumeric(Mid(chaine, Pos2, 1)) Then '3
							'MsgBox "Nombre de caratère = " & Pos2 - Pos1 + 1
							'MsgBox "Verif Modulo =" & (Pos2 - Pos1 + 1) Mod 8
							'MsgBox "Condition copie chiffre" & ((Pos2 - Pos1 + 1) Mod 8 = 0 And (strlettre = "" Or LCase(strlettre) = "cel" Or LCase(strlettre) = "tel"))
							If ((Pos2 - Pos1 + 1) Mod 8 = 0 And (strlettre = "" Or LCase(strlettre) = "cel" Or LCase(strlettre) = "tel")) Then '4
								start = Pos1
								For j = 1 To (Pos2 - Pos1 + 1) / 8
									'MsgBox "Numéro de tel = " & Mid(chaine, start, 8)
									NumTel = NumTel & " - " & Mid(chaine, start, 8)
									start = start + 8
								Next j
								strlettre = ""
								Pos1 = Pos2 + 1
								Pos2 = ""
							End If '4
						Else '3
							'MsgBox "La chaine = " & Mid(chaine, Pos1, Pos2 - Pos1 + 1)
							strlettre = Mid(chaine, Pos1, Pos2 - Pos1 + 1)
							Pos1 = Pos2 + 1
							'MsgBox "Nouvelle position P1= " & Pos1
							Pos2 = ""
						End If '3
				End If '2
	'Next i
		i = i + 1
		Loop
	Else '1
		NumTel = ""
	End If '1
	
End Function