Microsoft 365 colorer des onglets

[fantasio]

Bonjour à tous

Je souhaiterai que mes onglets se colorent en rouge si la valeur de la cellule A1 est supérieur à 0.

J'ai 22 onglets sur ma page
dans la mesure du possible je souhaiterai appliquer cette condition à l'ensemble de mon fichier


Merci d'avance pour votre aide

 

[vgendron]

bonjour

macro à utiliser

Sub Macro1()
For Each ws In ActiveWorkbook.Sheets
If ws.Range("A1") > 0 Then
With ws.Tab
.Color = 255
.TintAndShade = 0
End With
End If
Next ws
End Sub

 

[TooFatBoy]

Bonjour,

Une proposition :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'
    With Sh
        If Not Intersect(.Range("A1"), Target) Is Nothing Then
            If .Range("A1").Value > 0 Then
                .Tab.Color = RGB(255, 0, 0)
            Else
                .Tab.Color = xlAutomatic
            End If
        End If
    End With
    
End Sub

Attention, ça fonctionne pour tous les onglets du classeur.

 

[fantasio]

Bonjour à tous les 2

et merci pour votre reponse rapide mais

ou est ce que j'écris votre formule

 

[vgendron]

il ne s'agit pas de formule.. mais de macro
à mettre
1) dans un module standard pour ma proposition
2) dans le module "Thisworkbook" pour celle de Toofatboy (sa proposition est meilleure et il vaut mieux la privilgier à la mienne)

 

[TooFatBoy]

Tu ouvres VBE (<Alt>+<F11>) et tu colles ça dans ThisWorkbook.

 

[TooFatBoy]

il ne s'agit pas de formule.. mais de macro
à mettre
1) dans un module standard pour ma proposition
2) dans le module "Thisworkbook" pour celle de Toofatboy (sa proposition est meilleure et il vaut mieux la privilgier à la mienne)

Merci, c'est gentil, mais si la proposition de #3 a l'avantage de "décolorier" l'onglet si A1 n'est pas >0 (mais on ne sait pas si c'est souhaité puisque non demandé dans la question...), elle a aussi le gros inconvénient de fonctionner pour tous les onglets du classeur même ceux pour lesquels on ne voudrait pas qu'elle s'applique...

 

[fantasio]

Bonjour
je suis désolé mais je n'y arrive pas
j'ai fait alt+F11
Dans l'onglet thisworkbook, j'ai recopié le texte ci dessous

j'ai enregistré
mais ca ne marche pas

J'ai raté quelque chose mais je ne sais pas quoi



Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'
With Sh
If Not Intersect(.Range("A1"), Target) Is Nothing Then
If .Range("A1").Value > 0 Then
.Tab.Color = RGB(255, 0, 0)
Else
.Tab.Color = xlAutomatic
End If
End If
End With

End Sub

 

[TooFatBoy]

J'ai raté quelque chose mais je ne sais pas quoi

Le coloriage ne se fait que lorsque tu changes le contenu de A1 dans une feuille.

 

[Staple1600]

Bonjour sur le fil

Pour les Ifophobes,
Toujours dans ThisWorkBook

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Sh.Tab.Color = IIf(Sh.[A1] > 0, vbRed, -4105)
End Sub

NB: Juste pour le fun et parce qu'il pleut.

EDITION:
Comme il pleut toujours, et qu'il existe aussi peut être des IIFophobes

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Sh.Tab.Color = Choose(Abs((Sh.[A1] > 0) - 1), -4105, vbRed)
End Sub

 

[TooFatBoy]

Bon après-midi ensoleillé

 

[fantasio]

Je suis désolé de vous embeter
y a une subtilité à ma demande qui fait que la formule que vous m'avez donné ne marche pas

Ma cellule A1 correspond à une addition de plusieurs de cellules

Effectivement si je tape un chiffre en A1 ma cellule devient rouge

Par contre si le résultat de ma formule est supérieur à zéro - ca ne marche pas

 

[Staple1600]

Re

@fantasio
En mettant le code de ton choix dans cette procédure, cela devrait mieux fonctionner

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Sh.Tab.Color = Choose(Abs((Sh.[A1] > 0) - 1), -4105, vbRed)
End Sub

 

[Gégé-45550]

Je suis désolé de vous embeter
y a une subtilité à ma demande qui fait que la formule que vous m'avez donné ne marche pas

Ma cellule A1 correspond à une addition de plusieurs de cellules

Effectivement si je tape un chiffre en A1 ma cellule devient rouge

Par contre si le résultat de ma formule est supérieur à zéro - ca ne marche pas

Bonjour,
... et si tu postais ton fichier, ne serait-ce pas plus simple pour tout le monde ?
Bonne soirée

 

[TooFatBoy]

y a une subtilité à ma demande qui fait que la formule que vous m'avez donné ne marche pas

Le camarade vgendron l'a déjà dit : ce n'est pas une formule mais une macro !

---

... et si tu postais ton fichier, ne serait-ce pas plus simple pour tout le monde ?

anonymisé bien évidemment. Cela va sans dire.