Microsoft 365 colorer des onglets

vgendron

XLDnaute Barbatruc

• 17 Juin 2024

• #2

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

 

Vote positif 0 Vote négatif

TooFatBoy

XLDnaute Barbatruc

• 17 Juin 2024

• #3

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.

 

Vote positif 0 Vote négatif

F

fantasio

XLDnaute Nouveau

• 17 Juin 2024

• #4

Bonjour à tous les 2

et merci pour votre reponse rapide mais

ou est ce que j'écris votre formule

 

Vote positif 0 Vote négatif

vgendron

XLDnaute Barbatruc

• 17 Juin 2024

• #5

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)

 

Vote positif 0 Vote négatif

TooFatBoy

XLDnaute Barbatruc

• 17 Juin 2024

• #6

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

 

Vote positif 0 Vote négatif

TooFatBoy

XLDnaute Barbatruc

• 17 Juin 2024

• #7

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)

Cliquez pour agrandir...

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

 

Dernière édition: 17 Juin 2024

Vote positif 0 Vote négatif

F

fantasio

XLDnaute Nouveau

• 17 Juin 2024

• #8

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

 

Vote positif 0 Vote négatif

TooFatBoy

XLDnaute Barbatruc

• 17 Juin 2024

• #9

fantasio à dit:

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

Cliquez pour agrandir...

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

 

Dernière édition: 17 Juin 2024

Vote positif 0 Vote négatif

Staple1600

XLDnaute Barbatruc

• 17 Juin 2024

• #10

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

 

Dernière édition: 17 Juin 2024

Vote positif 0 Vote négatif

TooFatBoy

XLDnaute Barbatruc

• 17 Juin 2024

• #11

Bon après-midi ensoleillé
🥀 🌞 🥨

 

Vote positif 0 Vote négatif

F

fantasio

XLDnaute Nouveau

• 17 Juin 2024

• #12

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 😢

 

Vote positif 0 Vote négatif

Staple1600

XLDnaute Barbatruc

• 17 Juin 2024

• #13

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

 

Vote positif 0 Vote négatif

Gégé-45550

XLDnaute Accro

• 17 Juin 2024

• #14

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 😢

Cliquez pour agrandir...

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

 

Vote positif 0 Vote négatif

TooFatBoy

XLDnaute Barbatruc

• 17 Juin 2024

• #15

fantasio à dit:

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

Cliquez pour agrandir...

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 ?

Cliquez pour agrandir...

anonymisé bien évidemment. Cela va sans dire. 😉

 

Vote positif 0 Vote négatif