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

Taty 1973 · 6 Janvier 2022

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

JM27 · 7 Janvier 2022

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

Wayki · 7 Janvier 2022

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 +

JM27 · 7 Janvier 2022

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

patricktoulon · 7 Janvier 2022

Bonjour
un exemple a 3 couleurs de 0 à 100
comme ça vite fait à l'arrache

bleu tu es large
vert tu es tranquille
rouge complet t'es mort

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

Taty 1973 · 7 Janvier 2022

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 +

Bonjour Wayki, merci pour votre réponse, je vais essayer

Taty 1973 · 7 Janvier 2022

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

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 +

patricktoulon à dit:
Bonjour
un exemple a 3 couleurs de 0 à 100
comme ça vite fait à l'arrache

bleu tu es large

vert tu es tranquille

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

Bonté divine, je ne sais pas quand, mais c'est certain que je vais essayer. Merci

Taty 1973 · 7 Janvier 2022

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

Bonjour et merci pour votre aide. Si ça peut vous aider d'avoir mon fichier pour m'aider, ça me va

JM27 · 7 Janvier 2022

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

patricktoulon · 7 Janvier 2022

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

Taty 1973 · 7 Janvier 2022

Très bonne question, je ne savais pas qu'on pouvait faire des commentaires dans le codage. J'ai fait comme dans le vidéo. Si vous pensez au mot Bizarre, ne vous inquiétez pas dans mon cas c'est normale

Taty 1973 · 7 Janvier 2022

JM27 à dit:
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

Un gros merci, ça fonctionne, et j'ai appris que si on met un apostrophe au début de la ligne ça devient un commentaire

Taty 1973 · 7 Janvier 2022

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

Un gros merci, ça fonctionne.

Taty 1973 · 7 Janvier 2022

Un gros merci de m'avoir aidé. Je suis super contente

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

Taty 1973

XLDnaute Nouveau

Pièces jointes

JM27

Wayki

XLDnaute Impliqué

JM27

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Taty 1973

XLDnaute Nouveau

Pièces jointes

Taty 1973

XLDnaute Nouveau

Taty 1973

XLDnaute Nouveau

Pièces jointes

JM27

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Taty 1973

XLDnaute Nouveau

Taty 1973

XLDnaute Nouveau

Taty 1973

XLDnaute Nouveau

Taty 1973

XLDnaute Nouveau

Discussions similaires