Mise en forme automatique

Bonjour

Je souhaite avoir une mise en forme automatique après avoir saisi le code du pays sur le numéro de téléphone

La personne choisit son pays (France ou UK par exemple) dans le menu liste de la colonne A et lorsqu'il tape son numéro dans la colonne B que le numéro se mette en forme automatiquement avec le code du pays.

exemple : il choisit pays FR et qu'il saisisse son numéro ##.##.##.##.## ou ########## ou ## ## ## ## ## excel mette en forme automatiquement après validation en 33#########

Que soit supprimé les point ou les espaces, que le 06 ou 07 soit transformé en 6 ou 7 avec le 33 devant.

Et du coup la même chose si il choisit UK avec 44###### à la place de +44

Je suis arrivé à faire une mise en forme personnalisé pour le 33######### mais qui ne fonctionne pas quand est saisi le numéro avec les points ou les espaces.

Et je n'arrive pas à trouver la bonne formule pour ajouter les indicatifs automatiquement

UN GRAND MERCI POUR VOTRE AIDE

Bonjour,

Voici un premier essai sans gérer pour l'instant la question de l'indicatif car je pense qu'il est nécessaire d'avoir le fichier. Ce code est à placer dans le module de la feuille concernée par ces saisies de numéros :

private sub worksheet_change(byval target as range)

set r = intersect(target, range("A:A"))
tmodif = array(".", "-", " ", "_", "/")

if not r is nothing then
    application.enableevents = false
    for each cell in r
        nvval = cell.value
        if nvval like "#*#*#*#" then
            for i = lbound(tmodif) to ubound(tmodif)
                nvval = replace(nvval, tmodif(i), "")
            next i
            cell.value = "+33" & nvval * 1
        end if
    next cell
    application.enableevents = true
end if

end sub

La mise en forme porte uniquement sur la colonne A.

Cdlt,

Génial !!!! Un grand merci !!!!
Et est-il possible d'ajouter dans le code une condition genre si l'indicatif est FR il y a un message si le numéro n'a pas 11 digit (33 # ## ## ## ##) ?

Pour l'indicatif voulez vous le fichier ?

Encore Merci

Oui, comme je l'ai dit sur mon précédent message , je pense que le fichier (enfin une copie simplifiée et anonymisée ne contenant que l'essentiel) est nécessaire pour l'indicatif.

Cdlt,

Merci !!!!!!! Un grand merci !

Re,

Voici votre fichier avec le code mis à jour :

Private Sub worksheet_change(ByVal target As Range)

Set wf = WorksheetFunction
Set r = Intersect(target, Range("C:C"))
tmodif = Array(".", "-", " ", "_", "/")

If Not r Is Nothing Then
    Application.EnableEvents = False
    For Each cell In r
        pays = IIf(cell.Offset(0, -1).Value <> "", cell.Offset(0, -1).Value, "FR")
        prefixe = wf.Index(Sheets("Listes").Range("Liste[Indicatifs]"), wf.Match(pays, Sheets("Listes").Range("Liste[Code]"), 0))
        nvval = cell.Value
        If nvval Like "#*#*#*#" Then
            For i = LBound(tmodif) To UBound(tmodif)
                nvval = Replace(nvval, tmodif(i), "")
            Next i
            cell.Value = "'+" & prefixe & nvval * 1
        End If
    Next cell
    Application.EnableEvents = True
End If

End Sub

Ici, le code dépend du tableau structuré nommé "Liste" sur la feuille nommée "Listes" qui recense tous les indicatifs des pays. Cet élément est important : il faudra refaire le même tableau sur votre fichier ou adapter le code en conséquence.

Sinon, par défaut, quand le pays n'est pas renseigné sur la feuille de TEST, on considère que le pays est la France.

Cdlt,

OH LA LA !!!! Genial !!!!! Trop fort !!! Merci

Par contre, est-il possible de ne pas avoir le "+" devant l'indicatif ? je n'ai pas réussi à voir ou il est possible de le modifier.

Encore merci

J'ai hésité à parler du "+" sur mon précédent post...

Oui, il faut modifier cette ligne :

cell.Value = "'+" & prefixe & nvval * 1

par

cell.Value = prefixe & nvval * 1

Cdlt,

J'ai tenté de mettre mon fichier à jour et j'ai tout pété

Pouvez m'aider ?

Lol ! Tout pété ? Je vais tenter de faire sans le fichier pour que vous y parveniez seul au cas où...

En cas de bug, on peut se retrouver avec les évènements désactivés car la macro repose sur l'évènement change (changement valeur de cellule). Or, on rechange dans cette macro la valeur (après mise au format). Pour éviter de répéter inutilement cet évènement, il est désactivé avant le for puis réactivé après. Et si un bug survient à l'intérieur du for, les évènements restent désactivés.

C'est pour cette raison que j'ai laissé une petite macro en-dessous. Il faut aller dessus et l'exécuter (F5).

Maintenant, pour le bug, j'imagine qu'il se produit sur la ligne prefixe. Si mon intuition est bonne, il faut bien veiller à nommer correctement les bons objets :

- la feuille avec la liste > "Listes"

- sur cette feuille, le tableau doit être mis sous forme de tableau structuré et être renommé "Liste" (les noms de colonnes doivent être les mêmes que ceux du code également).

Cdlt,

Voici le code à jour :

Private Sub worksheet_change(ByVal target As Range)

Set wf = WorksheetFunction
Set r = Intersect(target, Range("D:D"))
tmodif = Array(".", "-", " ", "_", "/")

If Not r Is Nothing Then
    Application.EnableEvents = False
    For Each cell In r
        pays = IIf(cell.Offset(0, -1).Value <> "", cell.Offset(0, -1).Value, "France")
        prefixe = wf.Index(Sheets("Listes").Range("Liste[Indicatifs]"), wf.Match(pays, Sheets("Listes").Range("Liste[Pays]"), 0))
        nvval = cell.Value
        If nvval Like "#*#*#*#" Then
            For i = LBound(tmodif) To UBound(tmodif)
                nvval = Replace(nvval, tmodif(i), "")
            Next i
            cell.Value = prefixe & nvval * 1
        End If
    Next cell
    Application.EnableEvents = True
End If

End Sub

Et le fichier :

Cdlt,

Trop FORT et merci de vos explications qui m'aident à mieux comprendre.

2 dernières questions à priori :) :)

- Est il possible de mettre une message d'erreur si le numéro FR n'a pas été saisi avec 11 digits ?
- Si le numéro est saisi avec le +, la mise en forme ne se fait pas ? Est ce possible d'appliquer la mise en forme pour un numéro saisi manuellement en +336xxxxxx ?

Pour un numéro saisi avec le plus :

If nvval Like "*#*#*#*#*#*" Then

on change la condition.

D'ailleurs, cette condition est assez approximative et suppose que l'utilisateur ne saisira pas n'importe quoi. Mais, en l'état, il est difficile de restreindre plus sans alourdir le code et sans examiner les extrêmes possibilités en fonction des pays...

Pour le test sur les 11 chiffres :

Private Sub worksheet_change(ByVal target As Range)

Set wf = WorksheetFunction
Set r = Intersect(target, Range("D:D"))
tmodif = Array(".", "-", " ", "_", "/")

If Not r Is Nothing Then
    Application.EnableEvents = False
    For Each cell In r
        pays = IIf(cell.Offset(0, -1).Value <> "", cell.Offset(0, -1).Value, "France")
        prefixe = wf.Index(Sheets("Listes").Range("Liste[Indicatifs]"), wf.Match(pays, Sheets("Listes").Range("Liste[Pays]"), 0))
        nvval = cell.Value
        If nvval Like "*#*#*#*#*#*" Then
            For i = LBound(tmodif) To UBound(tmodif)
                nvval = Replace(nvval, tmodif(i), "")
            Next i
            cell.Value = prefixe & nvval * 1
            if pays = "France" and len(cell.value) <> 11 then cell.interior.color = 255
        End If
    Next cell
    Application.EnableEvents = True
End If

End Sub

Pas de message (ce code est censé fonctionner pour plusieurs cellules et non une seule donc la boucle avec un message à chaque fois, pas top) mais la cellule coloriée en rouge.

C'est génial !!!!! Merci !!!

Finalement j'ai une autre question, dans la colonne email, peut on avec un code forcer la suppression du lien hypertexte quand une ou plusieurs adresses emails sont collé dans les cellules ?

Quand je les saisi manuellement c'est bon mais pas lorsque que je les colle :(

Ah finalement, c'est pas fini^^

Oui, je pense que c'est possible. Un essai pour forcer la suppression des liens hypertextes :

Private Sub worksheet_change(ByVal target As Range)

Set r = Intersect(target, Range("B:B")) '<<< adapter

If Not r Is Nothing Then
    For Each cell In r
        if cell.value like "*@*" then
            cell.hyperlinks.delete
        end if
    Next cell
End If

End Sub

Si ton problème est résolu, merci de clôturer le sujet et d'éventuellement en créer d'autres si tu as d'autres questions

Cdlt,

Merci pour ce code, je dois le mettre à la suite de l'autre ou avant l'autre ou dans une autre page ?

Merci encore :) :)

Dans le même évènement :

Private Sub worksheet_change(ByVal target As Range)

Set wf = WorksheetFunction
set rmail = Intersect(target, Range("B:B"))
Set rtel = Intersect(target, Range("D:D"))
tmodif = Array(".", "-", " ", "_", "/")

If Not rmail Is Nothing Then
    For Each cell In rmail 
       if cell.value like "*@*" then
            cell.hyperlinks.delete
        end if
    Next cell
End If

If Not rtel is nothing then
    Application.EnableEvents = False
    For Each cell In rtel
        pays = IIf(cell.Offset(0, -1).Value <> "", cell.Offset(0, -1).Value, "France")
        prefixe = wf.Index(Sheets("Listes").Range("Liste[Indicatifs]"), wf.Match(pays, Sheets("Listes").Range("Liste[Pays]"), 0))
        nvval = cell.Value
        If nvval Like "*#*#*#*#*#*" Then
            For i = LBound(tmodif) To UBound(tmodif)
                nvval = Replace(nvval, tmodif(i), "")
            Next i
            cell.Value = prefixe & nvval * 1
            if pays = "France" and len(cell.value) <> 11 then cell.interior.color = 255
        End If
    Next cell
    Application.EnableEvents = True
End If

End Sub

Merci

et dans ma colonne email à partir de la ligne 3 peut on bloquer "Police, Taille, pas de soulignage"....?

et cela même quand on colle une ou des dizaines d'adresse mail ?

Car j'ai bloqué sur le format texte mais lors d'un copier/coller, il reprend la mise en forme du document où sont copiés les adresses or je voudrais qu'elles soient toutes à la meme mise en forme "texte, noir, calibri, 11, sans soulignage"

Après promis j'en ai fini :)

Tu peux faire un collage spécial valeurs, ce sera plus simple je pense !

Mais sinon, c'est possible...

Et je peux avoir le code à intégrer svp ? car ce n'est pas moi qui vais copier/coller

Du coup ca me serait grandement utile :) :) :)

Please Please ? :)