XL 2016 Détection changement couleur texte

audureaumarc

XLDnaute Nouveau
Bonjour,

Mon but est d’analyser quelle est la couleur de texte d’une cellule, et surtout de détecter le changement de couleur suite à édition manuelle

Dans un module, j’ai ajouté la fonction

VB:
Function GetFontColor(ByVal Target As Range) As Integer
    GetFontColor = Target.Font.ColorIndex
End Function

Que j’appelle ensuite par
Code:
=GetFontColor(A2)

Ca fonctionne à ma guise (en renvoyant un nombre) sauf que le nombre renvoyé ne se met pas à jour en temps réel lorsque je change la couleur du texte (mon objectif)

Comment faire ? Merci
 

eriiic

XLDnaute Barbatruc
Bonjour,

changer une couleur ne génère pas d'événement.
Pas d'autre choix que de le faire au moment du besoin.
Ou si tu n'en as pas 10000 à faire tu peux le faire sur l'événement Selection_Change, mais il faut au moins cliquer sur une autre cellule pour être à jour.
eric
 

Dranreb

XLDnaute Barbatruc
Bonsoir.
Si on tient vraiment à ce que ça réagisse dès qu'on change la couleur de police, il y a moyen de le faire. Mais ça implique de lancer lors de la sélection de la cellule une boucle se terminant par un DoEvents, vérifiant en permanence si cette couleur n'a pas changé.
Enfin c'est un tout petit peu plus compliqué. Je l'ai fait dans ma fourniture CouleurCls.xlsm pour la couleur de fond de l'échantillon.
 

Dranreb

XLDnaute Barbatruc
Il est . La boucle est dans une procédure indépendante s'appelant SurveillerInteriorColor. Elle est lancée par un Application.OnTime Now pour ne pas empêcher la procédure qui le lance de se terminer (C'est un peu pour ça que je vous avais dit que c'était un tout petit peu compliqué).
 
Dernière édition:

audureaumarc

XLDnaute Nouveau
Bonjour @Dranreb,

J’ai adapté votre module pour détecter la couleur de texte (font) plutôt que le fond de la cellule, comme suit

VB:
Public Sub MonitorTextColorColor()
   Dim TestedCell As Range
   Set TestedCell = ActiveCell
   TextColor = TestedCell.Font.ColorIndex
   MonitoredTextColor = True
   On Error Resume Next
   Do While MonitoredTextColor
      If Err Then MonitoredTextColor = False: Exit Sub
      If TestedCell.Font.ColorIndex <> TextColor Then
         TextColor = TestedCell.Font.ColorIndex: ActiveCell.Offset(0, 3).Value = TestedCell.Font.ColorIndex
         End If: DoEvents: Loop
End Sub

Toutefois, je ne sais pas comment l’activer par votre méthode Application.OnTime Now
Pourriez-vous m’aider ? je vous remercie (fichier joint, B2 à tester)
 

Pièces jointes

  • Book1.xlsm
    12 KB · Affichages: 7

Dranreb

XLDnaute Barbatruc
Bonjour.
Une chose m'intrigue: comment faites vous pour changer un ColorIndex ?
Ils existent toujours, d'accord, mais dans les commandes Excel les choix de couleurs proposées déterminent un Color plutôt qu'un ColorIndex, à mon avis.
Édition: Ah non, apprès essai, le CororIndex est changé aussi. Je n'avais jamais remarqué. Mais est-ce que ça donne quelque chose dans tous les cas si on choisit Autre couleurs et tout ça ?…
Pour le lancer mettez le ApplicationOnTime dans une Sub Worksheet_SelectionChange dans le module Sheet1 (Sheet1)
Mais attention : Avant cela, obligez le d'abord à se terminer, au cas où il serait déjà en train de s'exécuter, en remettant MonitoredTextColor à False.
Cette variable doit être globale, déclaré Public MonitoredTextColor As Boolean.
 
Dernière édition:

Modeste geedee

XLDnaute Barbatruc
Bonsour®
Bonjour,
Pour le ColorIndex, je confirme que seulement certaines couleurs sont répertoriées, pas toutes, il manque donc toutes les nuances
Pour le reste, je vous contacte en privé
le colorindex est l'index choisi dans une palette de 56 couleurs parmi les 16 millions de couleurs disponibles via RGB
à un instant donné une seule palette est disponible
il est possible de creer une palette personnalisée (correspondance éventuelle avec le theme d'entreprise)
une palette modifiée n'est disponible que dans le classeur actif sauf liaison palette avec un classeur modele
les couleurs de la palette sont liées également aux couleurs disponibles en automatique dans les graphiques

indépendamment de la palette active et des ColorIndex
via VBA 8 couleurs sont identifiées en tant que constantes :
VbWhite, VbBlack, VbRed, VbGreen, VbYellow, VbCyan, VbBlue, VbMagenta
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Bonsoir.
Personnellement même si c'est l'imprécis Cell.Font.ColorIndex qu'on veut reproduire, c'est Cell.Font.Color que je préfèrerais surveiller.
Dans un module Standard :
VB:
Option Explicit
Public WFCRunning As Boolean
Public Sub WatchFontColor()
   Dim Cell As Range, FontColor As Long
   Set Cell = ActiveCell
   FontColor = Cell.Font.Color
   On Error Resume Next
   WFCRunning = True
   Do While WFCRunning
      If Err Then WFCRunning = False: Exit Sub
      If Cell.Font.Color <> FontColor Then
         Cell.Offset(0, 3).Value = Cell.Font.ColorIndex
         FontColor = Cell.Font.Color
         End If: DoEvents: Loop
   End Sub
Dans le module de l'objet Worksheet représentant la feuille où on veut le mettre en œuvre :
VB:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   WFCRunning = False ' S'il tourne déjà, le fait se terminer dès qu'il a à nouveau l'occasion de poursuivre son exécution.
   If Intersect(Target, Range("P3:P135")) Is Nothing Then Exit Sub
   Application.OnTime Now, "WatchFontColor" ' Sans interrompre cette exécution ci, planifie la sienne 
'     pour tout de suite, ou plus exactement pour dès que plus rien d'autre ne s'exécute, ni même lui.
   End Sub
 

Dranreb

XLDnaute Barbatruc
Chez moi ça marche: ça produit bien sur la même ligne en colonne S le ColorIndex d'une cellule de P3: P135 dont je change la couleur de police dans la feuille représentée par l'objet Worksheet contenant la Private Sub Worksheet_SelectionChange
À tout hasard joignez votre classeur que je voie ce qui ne va pas, s'il ne marche pas non plus chez moi..
 
Dernière édition:

Statistiques des forums

Discussions
311 709
Messages
2 081 774
Membres
101 816
dernier inscrit
Jfrcs