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

[Joffrey84]

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

 

[ChTi160]

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

 

[JHA]

Bonjour à tous,

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

JHA

 

[mapomme]

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).

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]

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).

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]

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]

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]

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 :

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]

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 :

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 :

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]

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 :

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]

Bonsoir @Joffrey84 ,

Je n'arrive pas à reproduire votre erreur

 

[Joffrey84]

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]

Bonjour @Joffrey84 ,

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

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]

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]

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.