Microsoft 365 colorer des onglets

fantasio · 17 Juin 2024

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 · 17 Juin 2024

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 · 17 Juin 2024

Bonjour,

Une proposition :

VB:

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 · 17 Juin 2024

Bonjour à tous les 2

et merci pour votre reponse rapide mais

ou est ce que j'écris votre formule

vgendron · 17 Juin 2024

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 · 17 Juin 2024

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

TooFatBoy · 17 Juin 2024

vgendron à dit:
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 · 17 Juin 2024

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 · 17 Juin 2024

fantasio à dit:
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 · 17 Juin 2024

Bonjour sur le fil

Pour les Ifophobes,
Toujours dans ThisWorkBook

VB:

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

VB:

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 · 17 Juin 2024

Bon après-midi ensoleillé

fantasio · 17 Juin 2024

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 · 17 Juin 2024

Re

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

Enrichi (BBcode):

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

Gégé-45550 · 17 Juin 2024

fantasio à dit:
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 · 17 Juin 2024

fantasio à dit:
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 !

Gégé-45550 à dit:
... et si tu postais ton fichier, ne serait-ce pas plus simple pour tout le monde ?

anonymisé bien évidemment. Cela va sans dire.

Microsoft 365 colorer des onglets

fantasio

XLDnaute Nouveau

vgendron

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

fantasio

XLDnaute Nouveau

vgendron

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

fantasio

XLDnaute Nouveau

TooFatBoy

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

fantasio

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

Gégé-45550

XLDnaute Accro

TooFatBoy

XLDnaute Barbatruc

Discussions similaires