Option Explicit
Sub PhoneFormat(ZZZ As String, Mode As Long)
Dim Cellule As Range, LastRow As Long, rng As Range, t$, fx$, area, rng2 As Range
Set rng = Selection
If rng.Cells.Count < 1 Then MsgBox "Vous devez sélectionner au moins une cellule pour appliquer cette macro", vbInformation: Exit Sub
LastRow = ActiveSheet.UsedRange.Rows.Count
Select Case Mode
Case 1: Set rng = rng
Case 2: Set rng = Cells(2, rng.Column).Resize(LastRow - 1, 1)
Case 3:
If rng.Areas.Count = 1 Then
Set rng = rng.Cells(2, 1).Resize(LastRow - 2, rng.Columns.Count)
Else
Set rng2 = rng.Areas(1).Cells(2).Resize(LastRow, 1)
For Each area In rng.Areas: Set rng2 = Union(rng2, area.Cells(2).Resize(LastRow, 1)): Next
Set rng = rng2
rng.interior.color=xlnone
End If
End Select
t = "application sur " & rng.Address(0, 0) & " de la fonction"
If rng.Rows.Count > 1000 Then
If MsgBox("Ca va prendre du temps sur : " & Format(Selection.Rows.Count, "##,###,##0") & " Cellules" & vbCrLf & "Voulez-vous continuer ?", vbOKCancel) = vbCancel Then Exit Sub
End If
Application.StatusBar = t & fx
ET_Telephone_ou_il_veut rng
Application.StatusBar = ""
End Sub
Function ET_Telephone_ou_il_veut(ByRef TargetRange As Range)
'format 0033-1-23456789
Dim Cell As Range
Dim NotPhoneNumber As Long, IntlPhoneNumber As Long
Dim PartFRPhone As String
For Each Cell In TargetRange
If Cell <> Empty Then
If Left(Cell.Text, 2) <> "06" Then
If IsNumeric(Left(Cell.Value, 2)) And Len(Cell.Text) <= 15 Then
Select Case Left(Cell.Value, 5)
Case "0033-"
PartFRPhone = Mid(Cell.Text, 6, Len(Cell.Text))
If InStr(PartFRPhone, Chr(45)) = 0 Then
If Len(PartFRPhone) = 9 Then
Cell.Value = "0033-" & Mid(PartFRPhone, 1, 1) & "-" & Mid(PartFRPhone, 2, 9)
Else
Cell.Interior.ColorIndex = 6
NotPhoneNumber = NotPhoneNumber + 1
End If
Else
If Len(PartFRPhone) <> 10 Then
Cell.Interior.ColorIndex = 6
NotPhoneNumber = NotPhoneNumber + 1
Else
'on ne fait rien !
End If
End If
Case "00331" ' <<<< verrue pour ce format à la noix !
Cell.Value = Replace(Cell.Value, "00331", "0033-1-")
'Ici Numéro Internationaux ... On ne fait rien pour l'instant !!!
Case "00262" '<<< Mayotte
Cell.Interior.ColorIndex = 8
IntlPhoneNumber = IntlPhoneNumber + 1
Case "00377" '<<< Monaco
Cell.Interior.ColorIndex = 8
IntlPhoneNumber = IntlPhoneNumber + 1
Case "0041-" '<<< Swiss
Cell.Interior.ColorIndex = 8
IntlPhoneNumber = IntlPhoneNumber + 1
Case "0039-" '<<< Italie
Cell.Interior.ColorIndex = 8
IntlPhoneNumber = IntlPhoneNumber + 1
Case "0049-" '<<< Allemagne
Cell.Interior.ColorIndex = 8
IntlPhoneNumber = IntlPhoneNumber + 1
Case "0032-" '<<< Belgique
Cell.Interior.ColorIndex = 8
IntlPhoneNumber = IntlPhoneNumber + 1
Case "0034-" '<<< Espagne
Cell.Interior.ColorIndex = 8
IntlPhoneNumber = IntlPhoneNumber + 1
Case "00353" '<<< Irelande
Cell.Interior.ColorIndex = 8
IntlPhoneNumber = IntlPhoneNumber + 1
Case "0044-" 'Grande Bretagne
Cell.Interior.ColorIndex = 8
IntlPhoneNumber = IntlPhoneNumber + 1
Case Else
If Len(Cell) = 9 Then
If Left(Cell, 1) <> 6 Then
Cell.Value = Format("0033" & Val(Replace(Replace(Cell.Value, " ", ""), ".", "")), "@@@@""-""@""-""@@@@@@@@")
Else
Cell.Value = Format("0033" & Val(Replace(Replace(Cell.Value, " ", ""), ".", "")), "@@@@""-""@@@@@@@@@")
End If
Else
Cell.Interior.ColorIndex = 6
NotPhoneNumber = NotPhoneNumber + 1
End If
End Select
Else
Cell.Interior.ColorIndex = 6
NotPhoneNumber = NotPhoneNumber + 1
End If
Else '<<<<<<<<< Traitement des "06"
PartFRPhone = Mid(Cell.Text, 4, Len(Cell.Text))
If InStr(PartFRPhone, Chr(45)) = 0 Then
If Len(PartFRPhone) = 8 Then
Cell.Value = "0033-" & "6" & "-" & Mid(PartFRPhone, 1, 9)
Else
Cell.Interior.ColorIndex = 6
NotPhoneNumber = NotPhoneNumber + 1
End If
Else
If Len(PartFRPhone) <> 8 Then
Cell.Interior.ColorIndex = 6
NotPhoneNumber = NotPhoneNumber + 1
Else
'on ne fait rien !
End If
End If
End If
End If
Next
If NotPhoneNumber + IntlPhoneNumber > 0 Then
MsgBox "Traitement fait, mais " & NotPhoneNumber & " numéro(s) non reconnu(s) comme téléphone (Jaune)" & vbCrLf & _
"Et " & IntlPhoneNumber & " reconnu(s) comme numéro(s) international/Internationaux (Bleu)", vbExclamation, "Attention Virginie !"
End If
End Function