Mise en forme automatique

Oui mais dans ce cas, il faut éduquer et faire confiance à ceux qui s'en occuperont. Apprendre le collage spécial est une bonne chose et le passage d'un cap dans l'utilisation d'excel...

Sinon, à adapter probablement :

with cells.font
    .bold = false
    .italic = false
    .underline = false
    .name = "Calibri"
    .color = xlautomatic
    .size = 11
    '.numberformat = "@"
end with

Bonne continuation,

Comme ceci :

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

With Cells.Font
.Bold = False
.Italic = False
.Underline = False
.Name = "Calibri"
.Color = xlAutomatic
.Size = 11
'.numberformat = "@"
End With
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 encore

Non comme ça, après tout dépend de la zone dont on souhaite maintenir la mise en forme :

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
    with cell
        If .Value Like "*@*" Then .Hyperlinks.Delete
        with .Font
            .Bold = False
            .Italic = False
            .Underline = False
            .Name = "Calibri"
            .Color = xlAutomatic
            .Size = 11
            '.numberformat = "@"
        End With
    end with
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 beaucoup

De la colonne A3 à la "fin" de la colonne A sans impacter A1 et A2

ca ne fonctionne pas :(

J'ai trouvé !!!! UN Très Très GRAND MERCI pour tout

Bravo à toi ! Je t'en prie, c'était un plaisir (enfin surtout au début ) !

Bonne continuation !

MERCI

tout fonctionne quand le classeur n'est pas protégé, dès que je protège le classeur, sur les cases email j'ai l'erreur 1004 sur Bold puis sur Italic :( :(

Je ne comprends pas pourquoi ?

Moi qui croyais que le problème était résolu .

C'est normal, les protections empêchent la modification que ce soit par le code ou en manuel.

Il faut éventuellement déprotéger la feuille, puis reprotéger et autoriser davantage de modifications (mise en forme, ...). Il est possible d'intégrer dans le code la déprotection puis, une fois les affaires finies, la protection.

ok c'est plus clair mais justement je ne veux pas la déprotéger pour éviter que les gens ne fassent n'importe quoi dans la mise en forme :( :(

pourtant ca fonctionne sur les numéros de téléphones :(

Vous auriez une idées pour palier ?

J'ai fait un essai qui marche :

Il faut éventuellement déprotéger la feuille, puis reprotéger et autoriser davantage de modifications (mise en forme, ...).

Donc il faut oter la protection, puis remettre la protection et sélectionner "Format de cellule". A priori, il n'y aura plus de problème...

Je n'ai rien fait et la mise en forme des numéros de téléphones ne fonctionne plus :( :(

Je suis vraiment nul :( :( pourquoi d'un coup ca ne fonctionne plus ?

Puis je mettre mon fichier en xlsx ou doit-il rester en xlsm ?

Non tu dois le laisser en xlsm puisqu'il contient des macros.

Moi, je me suis arrêté à la version 4. La seule chose qui "n'allait pas", c'est qu'ensuite, pour la questions des hypertetxtes, j'ai posé dans le code que la colonne des emails était la B alors que c'était la A.

Sinon, pour le reste, je t'invite à relire tous nos échanges (privés également), grâce auxquels tu trouveras la solution.

Indice : BUG > évènements à réactiver !

Pour le reste, ça marche bien. Il faut seulement rajouter l'autorisation de modifier les formats lors de la protection de la feuille...

J'ai trouvé :) :)

merci pour l'indice !!! :) :) :)

Comme on mis pour FONT (italic, bold...) on peut mettre genre majuscule = false ?

Regarde, tu n'arrêtes jamais d'enchainer les demandes !

Non, pour majuscule, ce n'est pas possible. par contre, on peut changer la valeur de la cellule :

Private Sub worksheet_change(ByVal target As Range)

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

If Not rmail Is Nothing Then
application.enableevents = false
For Each cell In rmail
    with cell
        If .Value Like "*@*" Then .Hyperlinks.Delete
        .value = lcase(.value)
        with .Font
            .Bold = False
            .Italic = False
            .Underline = False
            .Name = "Calibri"
            .Color = xlAutomatic
            .Size = 11
            '.numberformat = "@"
        End With
    end with
Next cell
application.enableevents = true
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

Bon, à plus sur un nouveau sujet peut-être

UN TRES TRES GRAND MERCI !!! SANS VOUS JE Ne serais arrivé à rien ou alors dans 6 mois

merci car j'ai aussi beaucoup appris. bonne continuation.

Bonjour 3GB

Encore moi :) :) :)

Est il possible d'intégrer un code pour modifier l'indicatif si y a eu mauvais choix dans le pays et que celui-ci est changé après la 1ère mise en forme ?

Merci Merci Merci

Salut LaJuillet,

Je pense que c'est possible mais ça peut s'avérer assez compliqué d'autant que les indicatifs n'ont pas un modèle précis (parfois ils ont 2 chiffres et d'autres fois 3 par exemple).

Le plus simple, pour éviter ce cumul de contrôles, serait de créer une autre colonne et de gérer ça par formule tout simplement...

Ok Merci :)

RE,

With cell

If .Value Like "*@*" Then cell.Interior.Color = 255

End With

Quel est le contraire de LIKE ? dislike not egal... ne fonctionne pas :(