Microsoft 365 Thermomètre change de couleur selon le total d'une cellule

T

Taty 1973

XLDnaute Nouveau
Bonjour à tous,

Pour les macros, je suis débutante et j'aurais besoin de votre aide. J'ai vu un vidéo sur YouTube que j'essaye de le reproduire.

J'ai un tableau pour des dépenses et juste à côté, j'ai un graphique style thermomètre et j'aimerais qui change de couleur selon le total des dépenses. Mon problème est que quand le montant arrive à 75%, la couleur bleu ne change pas en rouge. Dans la vidéo, il y a une macro avec des changements dans le code qui est lié. Quand je change les données dans le tableau j'ai un message Erreur de compilation: Else sans If et dans la fenêtre de code "Sub color ( )" est en jaune (color est le nom de ma macro).

Est ce qu'il y aurait une autre façon de faire?

Merci pour votre aide
 

Pièces jointes

  • Capture.PNG
    Capture.PNG
    76.2 KB · Affichages: 45
  • Capture2.PNG
    Capture2.PNG
    6.6 KB · Affichages: 40
  • Capture3.PNG
    Capture3.PNG
    24.7 KB · Affichages: 43
Solution
J
bonjour
Pourquoi cette ligne est en vert dans la macro ? ( en commentaire)

VB: 
If Sheets("Feuil1").Range("F5").Value <= 0,5 Then

De plus pas de virgule mais un point
Code: 
If Sheets("Feuil1").Range("F5").Value <= 0.5 Then
Trier par date Trier par votes
J

JM27

XLDnaute Barbatruc
Bonjour
Et si tu postais ta macro dans son intégralité?
car le problème se trouve ( a priori) au dessus ( il manque un if comme le dit le message) mais il faut se méfier des messages qui ne sont pas toujours corrects

exemple de if :

If machin=0.5 then
' ton action
elseif machin=0.7 then
' ton action1
elseif machin=0.8 then
' ton action2
elseif machin=0.9 then
' ton action3
end if
 
Dernière édition:
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
Bonjour
un exemple a 3 couleurs de 0 à 100
comme ça vite fait à l'arrache ;)
  1. bleu tu es large
  2. vert tu es tranquille
  3. rouge complet t'es mort😅
demo.gif


code dans la feuille concernée
la cellule référence c'est F2 des quelle change le thermomètre aussi
tu a donc un dégradé de 3 couleurs et l'effet vide tout en gardant les proportions couleurs
elle se réduisent ou disparaissent selon le niveau
VB: 
Private Sub CommandButton1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim A: A = [F2]
    If Button = 1 Then
        A = A + 3
        [F2] = Application.Min(A, 100)
        End If
End Sub

Private Sub CommandButton2_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim A: A = [F2]
    If Button = 1 Then
        A = A - 3
        [F2] = Application.Max(A, 0.1)
    End If
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$F$2" Then thermo
End Sub



Sub thermo()
    Dim X#, grd1#, grd2#, grd3#, grd4#, C1&
    X = (100 - [F2]) / 100
    C1 = RGB(255, 255, 150)    'couleur de fond
    With ActiveSheet.Shapes(1).Fill
        .ForeColor.RGB = C1
        .OneColorGradient msoGradientHorizontal, 1, 1
        If X > 0.02 Then gd1 = X Else gd1 = 0.02
        If X > 0.1 Then gd2 = X Else gd2 = 0.1
        If X > 0.3 Then gd3 = X Else gd3 = 0.3
        If X > 0.8 Then gd4 = X Else gd4 = 0.8

        .GradientStops.Insert (C1), gd1
        .GradientStops.Insert RGB(255, 0, 0), gd2
        .GradientStops.Insert RGB(0, 255, 0), gd3
        .GradientStops.Insert RGB(0, 0, 255), gd4
        .GradientStops.Insert RGB(0, 0, 255), 0.999
    End With
End Sub
;)
à toi d'adapter le nom de ta feuille , dela cellule de référence, peu être d'autre couleurs et la couleur de fond
 
Vote positif 0 Vote négatif
T

Taty 1973

XLDnaute Nouveau
JM27 à dit:
Bonjour
Et si tu postais ta macro dans son intégralité?
car le problème se trouve ( a priori) au dessus ( il manque un if comme le dit le message) mais il faut se méfier des messages qui ne sont pas toujours corrects

exemple de if :

If machin=0.5 then
' ton action
elseif machin=0.7 then
' ton action1
elseif machin=0.8 then
' ton action2
elseif machin=0.9 then
' ton action3
end if
Cliquez pour agrandir...

Wayki à dit:
Bonjour,
Normalement il y a un ":" entre else et if.
Sans fichier impossible de vous aider +
Vous pouvez également utiliser Select case et case, un peu plus lisible que des if, else if etc
A +
Cliquez pour agrandir...
patricktoulon à dit:
Bonjour
un exemple a 3 couleurs de 0 à 100
comme ça vite fait à l'arrache ;)
  1. bleu tu es large
  2. vert tu es tranquille
  3. rouge complet t'es mort😅
Regarde la pièce jointe 1126837

code dans la feuille concernée
la cellule référence c'est F2 des quelle change le thermomètre aussi
tu a donc un dégradé de 3 couleurs et l'effet vide tout en gardant les proportions couleurs
elle se réduisent ou disparaissent selon le niveau
VB: 
Private Sub CommandButton1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim A: A = [F2]
    If Button = 1 Then
        A = A + 3
        [F2] = Application.Min(A, 100)
        End If
End Sub

Private Sub CommandButton2_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim A: A = [F2]
    If Button = 1 Then
        A = A - 3
        [F2] = Application.Max(A, 0.1)
    End If
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$F$2" Then thermo
End Sub



Sub thermo()
    Dim X#, grd1#, grd2#, grd3#, grd4#, C1&
    X = (100 - [F2]) / 100
    C1 = RGB(255, 255, 150)    'couleur de fond
    With ActiveSheet.Shapes(1).Fill
        .ForeColor.RGB = C1
        .OneColorGradient msoGradientHorizontal, 1, 1
        If X > 0.02 Then gd1 = X Else gd1 = 0.02
        If X > 0.1 Then gd2 = X Else gd2 = 0.1
        If X > 0.3 Then gd3 = X Else gd3 = 0.3
        If X > 0.8 Then gd4 = X Else gd4 = 0.8

        .GradientStops.Insert (C1), gd1
        .GradientStops.Insert RGB(255, 0, 0), gd2
        .GradientStops.Insert RGB(0, 255, 0), gd3
        .GradientStops.Insert RGB(0, 0, 255), gd4
        .GradientStops.Insert RGB(0, 0, 255), 0.999
    End With
End Sub
;)
à toi d'adapter le nom de ta feuille , dela cellule de référence, peu être d'autre couleurs et la couleur de fond
Cliquez pour agrandir...

Bonté divine, je ne sais pas quand, mais c'est certain que je vais essayer. Merci
 
Vote positif 0 Vote négatif
T

Taty 1973

XLDnaute Nouveau
JM27 à dit:
Bonjour
Et si tu postais ta macro dans son intégralité?
car le problème se trouve ( a priori) au dessus ( il manque un if comme le dit le message) mais il faut se méfier des messages qui ne sont pas toujours corrects

exemple de if :

If machin=0.5 then
' ton action
elseif machin=0.7 then
' ton action1
elseif machin=0.8 then
' ton action2
elseif machin=0.9 then
' ton action3
end if
Cliquez pour agrandir...
Bonjour et merci pour votre aide. Si ça peut vous aider d'avoir mon fichier pour m'aider, ça me va
 

Pièces jointes

  • Graphique interactif suivre dépenses macro.xlsm
    24.9 KB · Affichages: 15
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
il fonctionne le tien suffisait de debloquer le 1er if et un "." a la place de"," c'est tout
c'est sympa l'effet bouteille comme ca
VB: 
Sub color()
'
' color Macro
'

If Sheets("Feuil1").Range("F5").Value <= 0.5 Then
    ActiveSheet.Shapes.Range(Array("Group 5")).Select
    ActiveSheet.ChartObjects("Graphique 3").Activate
    ActiveChart.FullSeriesCollection(2).Select
    Application.CommandBars("Format Object").Visible = False
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 112, 192)
        .Transparency = 0.6399999857
        .Solid
    End With
    Range("B7").Select
 ElseIf Sheets("Feuil1").Range("F5").Value <= 0.7 Then
    ActiveSheet.Shapes.Range(Array("Group 5")).Select
    ActiveSheet.ChartObjects("Graphique 3").Activate
    ActiveChart.FullSeriesCollection(2).Select
    Application.CommandBars("Format Object").Visible = False
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0.6399999857
        .Solid
    End With
    Range("B7").Select
 Else
  ActiveSheet.Shapes.Range(Array("Group 5")).Select
    ActiveSheet.ChartObjects("Graphique 3").Activate
    ActiveChart.FullSeriesCollection(2).Select
    Application.CommandBars("Format Object").Visible = False
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    Range("B7").Select
 End If
End Sub
 
Vote positif 0 Vote négatif
T

Taty 1973

XLDnaute Nouveau
patricktoulon à dit:
il fonctionne le tien suffisait de debloquer le 1er if et un "." a la place de"," c'est tout
c'est sympa l'effet bouteille comme ca
VB: 
Sub color()
'
' color Macro
'

If Sheets("Feuil1").Range("F5").Value <= 0.5 Then
    ActiveSheet.Shapes.Range(Array("Group 5")).Select
    ActiveSheet.ChartObjects("Graphique 3").Activate
    ActiveChart.FullSeriesCollection(2).Select
    Application.CommandBars("Format Object").Visible = False
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 112, 192)
        .Transparency = 0.6399999857
        .Solid
    End With
    Range("B7").Select
 ElseIf Sheets("Feuil1").Range("F5").Value <= 0.7 Then
    ActiveSheet.Shapes.Range(Array("Group 5")).Select
    ActiveSheet.ChartObjects("Graphique 3").Activate
    ActiveChart.FullSeriesCollection(2).Select
    Application.CommandBars("Format Object").Visible = False
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0.6399999857
        .Solid
    End With
    Range("B7").Select
 Else
  ActiveSheet.Shapes.Range(Array("Group 5")).Select
    ActiveSheet.ChartObjects("Graphique 3").Activate
    ActiveChart.FullSeriesCollection(2).Select
    Application.CommandBars("Format Object").Visible = False
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    Range("B7").Select
 End If
End Sub
Cliquez pour agrandir...
Un gros merci, ça fonctionne.
 
Vote positif 0 Vote négatif

Discussions similaires

H
  • Question
XL 2021 Couleurs des graphiques qui se remettent par défaut sur fichier partagé, c'est usant
Réponses
1
Affichages
377
Efgé
Efgé
Yann71
  • Question
Microsoft 365 Compter le nombre de cellule mise en couleur avec MFC
2
Réponses
19
Affichages
709
job75
job75
P
  • Question
Microsoft 365 Problème d'affichage étiquettes Graphique
Réponses
8
Affichages
206
Piment
P
E
  • Question
Microsoft 365 Couleurs de fichiers qui changent
Réponses
1
Affichages
272
mapomme
mapomme
D
  • Question
Microsoft 365 Compter les couleur avec MFC
2
Réponses
19
Affichages
746
TooFatBoy
TooFatBoy
P
  • Résolu(e)
XL pour MAC Problème de changement de couleur de la valeur d'une cellule
Réponses
2
Affichages
269
pvander
P
P
  • Résolu(e)
Microsoft 365 Macro qui change l'épaisseur du contour d'une forme
Réponses
11
Affichages
275
pat66
P
Lu76Fer
XLS : Sélecteur de Couleur
Réponses
8
Affichages
259
Lu76Fer
Lu76Fer
S
  • Résolu(e)
XL 2016 si cellule de couleur alors écrire X
Réponses
2
Affichages
620
sevsev38
S
E
  • Résolu(e)
Microsoft 365 Couleur Police sur grand nombre de cellules
2
Réponses
22
Affichages
911
TooFatBoy
TooFatBoy

Membres actuellement en ligne

4 membres et 81 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 096
Messages
2 116 183
Membres
112 677
dernier inscrit
Justine11