Microsoft 365 Code VBA police de couleur

[DR85]

Bonjour,

Dans le fichier j’ai une colonne avec des nombres. Certains ne sont pas en police de couleur noire.
Si une cellule de la colonne G n’est pas en police de couleur noire alors renvoyer le texte « PROD » en colonne V (même ligne).
Précision: la colonne G se remplira au fil des jours.
pourriez vous svp m’aider?
cordialement
Damien

 

[sylvanu]

Bonjour DR,
Un essai en PJ avec une fonction perso en colonne V :

Function Prod(C As Range)
    If C.Font.Color <> 0 Then Prod = "Prod" Else Prod = ""
End Function

 

[DR85]

Bonjour DR,
Un essai en PJ avec une fonction perso en colonne V :

Function Prod(C As Range)
    If C.Font.Color <> 0 Then Prod = "Prod" Else Prod = ""
End Function

Merci,
Je regarde ça dans la journée. Je vous tiens au courant.
Bon après-midi

 

[sylvanu]

Mais lorsque la colonne G "s'agrandit" il faut penser à copier les formules de la colonne V.
Sinon le faire par macro avec un bouton de mise à jour, ou copier la formule en V sur plusieurs milliers de lignes pour que cela soit automatique.

 

[RyuAutodidacte]

Autre proposition avec une Sub :

Sub CheckTxtColor()
Dim DerL As Long, Rg As Range, R, L As Long

    With Feuil1
        DerL = .Cells(.Rows.Count, 7).End(xlUp).Row
        Set Rg = .Range("G1:G" & DerL)
        For Each R In Rg
            L = R.Row
            If R.Font.ColorIndex <> 1 Then
                .Range("V" & L).Value = "Prod"
            Else
                .Range("V" & L).Value = ""
            End If
        Next
    End With
    
    Set Rg = Nothing
    
End Sub

 

[patricktoulon]

Mais lorsque la colonne G "s'agrandit" il faut penser à copier les formules de la colonne V.
Sinon le faire par macro avec un bouton de mise à jour, ou copier la formule en V sur plusieurs milliers de lignes pour que cela soit automatique.

bonjour

voilà le genre de choses a quoi on a à faire quand on travaille pas avec des tableaux structurés
😉

 

[sylvanu]

Bonjour Patrick,
Reste à savoir d'où viennent les données. D'un import, d'un fichier tiers ...
Donc sans fichier test, on fait au mieux.

 

[DR85]

bonjour

voilà le genre de choses a quoi on a à faire quand on travaille pas avec des tableaux structurés
😉

Bonjour,
Fichier qui fera maximum 3500 lignes.
😉

 

[patricktoulon]

re
2 ligne ou 5000 c'est pareil dans un T S tu met la formule dans la première ligne c'est tout

 

[DR85]

re
2 ligne ou 5000 c'est pareil dans un T S tu met la formule dans la première ligne c'est tout

Re,
Je vais regarder ça
Merci

 

[mapomme]

Bonjour,

Attention! Quand vous changez la couleur de police, les résultats des fonctions (ou procédures) ne sont pas recalculés. Le changement de couleur (police et/ou fond de la cellule) ne déclenche pas d'évènement au niveau d'Excel. Il faut actualiser manuellement. Utiliser le forçage du recalcul par la combinaison des trois touches Ctrl+Alt+F9 (touche de fonction F9).

 

[DR85]

Bonjour,

Attention! Quand vous changez la couleur de police, les résultats des fonctions (ou procédures) ne sont pas recalculés. Le changement de couleur (police et/ou fond de la cellule) ne déclenche pas d'évènement au niveau d'Excel. Il faut actualiser manuellement. UUtiliser le forçage du recalcul par la combinaison des trois touches Ctrl+Alt+F9 (touche de fonction F9).

Bonjour,
Effectivement il n’y a pas d’actualisation automatique. Dommage c’était mon objectif. 😩
Je vais essayer le forçage…
Ou peut être un bouton actualiser, ça peut fonctionner?

 

[DR85]

Merci,
Je regarde ça dans la journée. Je vous tiens au courant.
Bon après-midi

C’est ok pour moi merci 🤩

 

[DR85]

Autre proposition avec une Sub :

Sub CheckTxtColor()
Dim DerL As Long, Rg As Range, R, L As Long

    With Feuil1
        DerL = .Cells(.Rows.Count, 7).End(xlUp).Row
        Set Rg = .Range("G1:G" & DerL)
        For Each R In Rg
            L = R.Row
            If R.Font.ColorIndex <> 1 Then
                .Range("V" & L).Value = "Prod"
            Else
                .Range("V" & L).Value = ""
            End If
        Next
    End With
   
    Set Rg = Nothing
   
End Sub

Bonjour,
Je n’ai pas encore essayer car la premiere proposition fonctionne. Mais je garde votre proposition pour un prochain test. Merci

 

[mapomme]

Bonjour,
Effectivement il n’y a pas d’actualisation automatique. Dommage c’était mon objectif. 😩
Je vais essayer le forçage…
Ou peut être un bouton actualiser, ça peut fonctionner?

Oui ça marche.