XL 2019 Comment modifier partiellement une cellule selon une liste déroulante

Joffrey84 · 1 Septembre 2020

Bonjour à tous,

C'est la première fois que je post sur un forum "Excel".

J'ai une liste déroulante relié en cascade qui selon les choix fait fait apparaître un texte. Mais les cellules des listes déroulantes comportent des underscores entre chaque mots car il ne peut pas y avoir d'espace.

Je cherche absolument a les masquer en mettant les "_" en police blanche. Mais je ne parviens pas à le faire sur mon tableur.
Je cherche à faire un macro évènementiel qui fonctionnerai automatiquement, le but étant que dès que je choisi une donnée sur ma liste déroulante tous les underscores passent en blanc.

A noter que ma liste déroulante se situe sur des groupes de cellules nommés : Flux_1 et Destinataire_1

Je ne peux malheureusement pas vous mettre en PJ le tableau car il comporte des informations confidentiel.

Cela fait 3j que je cherche une solution et je ne trouve rien.. Je débute à peine sur les macro.

Si quelqu'un a une solution ou une idée qu'il n'hésite pas!

Merci d'avance
Joffrey

mapomme · 4 Septembre 2020

Bonjour @Joffrey84 ,

Avec votre explication j'ai pu reproduire le défaut.
Le code suivant devrait corriger l'anomalie :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x, i&
   If Not Intersect(Target, Range("maZone")) Is Nothing Then
      Target.Font.ColorIndex = xlColorIndexAutomatic
      For Each x In Intersect(Target, Range("maZone"))
         For i = 1 To Len(x)
            If Mid(x, i, 1) = "_" Then x.Characters(i, 1).Font.Color = x.Interior.Color
         Next i
      Next x
   End If
End Sub

ChTi160 · 1 Septembre 2020

Bonjour joffrey
Bienvenue
Sans fichier (anonymisé) je pense que tu n'auras pas de réponse .
jean marie

JHA · 1 Septembre 2020

Bonjour à tous,

Peux-tu reporter le résultat de ta liste déroulante sur une autre cellule et utiliser la fonction substitue()

JHA

mapomme · 1 Septembre 2020

Bonjour @Joffrey84
Bienvenue sur XLD ,

Voir le code dans le module de la feuille "Feuil1". Le code est attaché à l'évènement Worksheet_Change(). Le code ne s'applique qu'à la zone nommée maZone (plage en jaune clair).

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x, i&
   For Each x In Intersect(Target, Range("maZone"))
      For i = 1 To Len(x)
         If Mid(x, i, 1) = "_" Then x.Characters(i, 1).Font.Color = x.Interior.Color
      Next i
   Next x
End Sub

Joffrey84 · 1 Septembre 2020

mapomme à dit:
Bonjour @Joffrey84
Bienvenue sur XLD ,

Voir le code dans le module de la feuille "Feuil1". Le code est attaché à l'évènement Worksheet_Change(). Le code ne s'applique qu'à la zone nommée maZone (plage en jaune clair).

VB:

Private Sub Worksheet_Change(ByVal Target As Range) Dim x, i& For Each x In Intersect(Target, Range("maZone")) For i = 1 To Len(x) If Mid(x, i, 1) = "_" Then x.Characters(i, 1).Font.Color = x.Interior.Color Next i Next x End Sub

Bonjour merci pour votre retour il me semble que la formule soit quasiment bonne (elle a fonctionné durant un temps puis à cessé de fonctionné et est maintenant en attente de débogage)

J'ai repris exactement ce que vous avez écris mais cette ligne bloque désormais :

For Each x In Intersect(Target, Range("Flux_1"))

A quoi peut-être dû le problème alors que cela fonctionné au début ?

Merci beaucoup pour votre retour !

Joffrey84 · 1 Septembre 2020

ChTi160 à dit:
Bonjour joffrey
Bienvenue
Sans fichier (anonymisé) je pense que tu n'auras pas de réponse .
jean marie

Bonjour,

Oui effectivement c'est ce que je pensais aussi mais ce sont des informations que je ne peux malheureusement en aucun cas poster..

Mais des personnes parviennent à me donner des formules malgré le fait qu'il ne connaissent pas la configuration du tableur alors je croise les doigts !

Merci pour votre retour

Joffrey84 · 1 Septembre 2020

JHA à dit:
Bonjour à tous,

Peux-tu reporter le résultat de ta liste déroulante sur une autre cellule et utiliser la fonction substitue()

JHA

Bonjour,

Non la liste déroulante doit être la cellule de lecture je ne peux pas substituer...

Merci quand même

mapomme · 1 Septembre 2020

Re,

J'avais oublié le cas où seules des cellules n’appartenant pas à la plage "maPlage" seraient modifiées.
Préférez le code suivant :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x, i&
   If Not Intersect(Target, Range("maZone")) Is Nothing Then
      For Each x In Intersect(Target, Range("maZone"))
         For i = 1 To Len(x)
            If Mid(x, i, 1) = "_" Then x.Characters(i, 1).Font.Color = x.Interior.Color
         Next i
      Next x
   End If
End Sub

Joffrey84 · 3 Septembre 2020

mapomme à dit:
Re,

J'avais oublié le cas où seules des cellules n’appartenant pas à la plage "maPlage" seraient modifiées.
Préférez le code suivant :

VB:

Private Sub Worksheet_Change(ByVal Target As Range) Dim x, i& If Not Intersect(Target, Range("maZone")) Is Nothing Then For Each x In Intersect(Target, Range("maZone")) For i = 1 To Len(x) If Mid(x, i, 1) = "_" Then x.Characters(i, 1).Font.Color = x.Interior.Color Next i Next x End If End Sub

Bonjour j'espère que vous allez bien,

Le problème se répète au début les underscores passent en blanc puis c'est toute la zone qui passe en blanc lorsque j'effectue des choix.

Actuellement j'ai réellement recopié votre formuleen changeant uniquement ma zone :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x, i&
   If Not Intersect(Target, Range("Flux_1")) Is Nothing Then
      For Each x In Intersect(Target, Range("Flux_1"))
         For i = 1 To Len(x)
            If Mid(x, i, 1) = "_" Then x.Characters(i, 1).Font.Color = x.Interior.Color
         Next i
      Next x

   End If
End Sub

[/QUOTE]

Je pense que l'erreur est mienne je vais comparer avec votre test que vous avez joint

Joffrey84 · 3 Septembre 2020

Joffrey84 à dit:
Bonjour j'espère que vous allez bien,

Le problème se répète au début les underscores passent en blanc puis c'est toute la zone qui passe en blanc lorsque j'effectue des choix.

Actuellement j'ai réellement recopié votre formuleen changeant uniquement ma zone :

VB:

Private Sub Worksheet_Change(ByVal Target As Range) Dim x, i& If Not Intersect(Target, Range("Flux_1")) Is Nothing Then For Each x In Intersect(Target, Range("Flux_1")) For i = 1 To Len(x) If Mid(x, i, 1) = "_" Then x.Characters(i, 1).Font.Color = x.Interior.Color Next i Next x End If End Sub

Je pense que l'erreur est mienne je vais comparer avec votre test que vous avez joint
[/QUOTE]

Le problème semble survenir lorsque mon choix dans ma liste déroulante se porte sur : _48Y_UD_ANC à partir de cette sélection le mot entier passe en blanc ainsi que tous les autres

mapomme · 3 Septembre 2020

Bonsoir @Joffrey84 ,

Je n'arrive pas à reproduire votre erreur

Joffrey84 · 4 Septembre 2020

Bonjour,

J'ai pu reproduire l'erreur que j'ai sur votre tableur que je joint ici.
Lorsque j'entre une donnée commençant par un underscore la vba fonctionne dans un premier temps. Mais lorsque je veux changer la donnée de la cellule avec la liste déroulante tous les autres mots inscrit passe en blanc. Le problème semble venir uniquement de ce détail.

S'il n'y a aucune formule pouvant corriger ceci, je peux changer l'intitulé de la cellule directement.

Merci pour votre aide en tout cas ça m'avance énormément

mapomme · 4 Septembre 2020

Bonjour @Joffrey84 ,

Avec votre explication j'ai pu reproduire le défaut.
Le code suivant devrait corriger l'anomalie :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x, i&
   If Not Intersect(Target, Range("maZone")) Is Nothing Then
      Target.Font.ColorIndex = xlColorIndexAutomatic
      For Each x In Intersect(Target, Range("maZone"))
         For i = 1 To Len(x)
            If Mid(x, i, 1) = "_" Then x.Characters(i, 1).Font.Color = x.Interior.Color
         Next i
      Next x
   End If
End Sub

Joffrey84 · 4 Septembre 2020

Re bonjour !

Cela fonctionne ! Par simple connaissance, qu'avez vous changé dans vos code et qu'est-ce qui fait que cela fonctionne désormais ?

Merci beaucoup pour votre aide et votre rapidité dans vos réponse c'était ma première publication sur un forum je ne m'attendais pas à avoir une réponse et qu'elle soit en plus en parfaite adéquation avec ce qu'il me fallait

mapomme · 4 Septembre 2020

Joffrey84 à dit:
Cela fonctionne ! Par simple connaissance, qu'avez vous changé dans vos code et qu'est-ce qui fait que cela fonctionne désormais ?

Avant de repérer chaque underscore, il fallait attribuer la valeur par défaut de la couleur de police à l'ensemble de la cellule Target.Font.ColorIndex = xlColorIndexAutomatic.
Sinon lors de la deuxième modification, il gardait en mémoire que le premier caractère n'était pas visible (puisque la première modif commençait par un underscore et donc était invisible) et ensuite il attribuait la couleur de police de ce premier caractère à l'ensemble du texte.
Le fait de réinitialiser la couleur de la police avant de rechercher les underscores attribue automatiquement cette couleur (visible) au premier caractère.

XL 2019 Comment modifier partiellement une cellule selon une liste déroulante

Joffrey84

XLDnaute Nouveau

mapomme

ChTi160

XLDnaute Barbatruc

JHA

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Pièces jointes

Joffrey84

XLDnaute Nouveau

Joffrey84

XLDnaute Nouveau

Joffrey84

XLDnaute Nouveau

mapomme

XLDnaute Barbatruc

Pièces jointes

Joffrey84

XLDnaute Nouveau

Joffrey84

XLDnaute Nouveau

mapomme

XLDnaute Barbatruc

Joffrey84

XLDnaute Nouveau

Pièces jointes

mapomme

XLDnaute Barbatruc

Pièces jointes

Joffrey84

XLDnaute Nouveau

mapomme

XLDnaute Barbatruc

Discussions similaires