Texte blanc dans une macro ?

Résolu
Guy72 -  

Bonjour,
J'ai une macro ci jointe.

Option Explicit


Dim R As Integer
Dim G As Integer
Dim B As Integer

Dim E As String


Public I13save ' Mémorisation des valeurs en publique

Sub Worksheet_Calculate()
    If [I13] <> I13save Then I13save = [I13]: Worksheet_Change ([I13]) 'Vent Maxi
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

'- Vent en rafale ----------------------------------------------------------------------
If Not Intersect(Target, Range("I13")) Is Nothing Then
Select Case Target.Value

Case Is = 0: R = 0: G = 250: B = 250
Case Is < 11: R = 190: G = 240: B = 250
Case Is < 21: R = 120: G = 170: B = 220
Case Is < 31: R = 230: G = 180: B = 180
Case Is < 41: R = 250: G = 152: B = 70
Case Is < 51: R = 192: G = 80: B = 77
Case Is < 61: R = 230: G = 110: B = 10
Case Is < 71: R = 201: G = 196: B = 10: E = vbWhite
Case Is < 81: R = 167: G = 62: B = 59: E = vbWhite
Case Is < 91: R = 250: G = 90: B = 90: E = vbWhite
Case Is < 101: R = 255: G = 70: B = 50: E = vbWhite
Case Is > 100: R = 255: G = 55: B = 0: E = vbWhite
End Select
Shapes("Texte Rafale").Fill.ForeColor.RGB = RGB(R, G, B)
End If
End Sub

au dessus de 60 km/h, je devrait avoir un texte blanc.
Je n'arrive pas à l'avoir. Y a-t-il une erreur dans la macro ?

Cordialement


Windows / Chrome 124.0.0.0

12 réponses

Résumé de la discussion

Le code met à jour la couleur de remplissage d’une forme via Shapes(...).Fill.ForeColor.RGB, sans agir sur la couleur du texte, la valeur E n’étant pas appliquée, ce qui empêche le texte de devenir blanc. Les déclencheurs de changement ne correspondent pas aux cellules observées: Bouée T°, Vent et Soleil utilisent respectivement I20, I28 et I24, alors que les déclenchements actuels ne s’appuient pas sur ces cellules pour une saisie manuelle. Pour obtenir du texte blanc, il faut appliquer une couleur RGB du texte (255,255,255) sur le texte du Shape, par exemple via TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255,255,255), et non en passant par la variable E. En somme, corriger les déclencheurs et régler l’application de la couleur du texte permettent de obtenir le texte blanc au-delà de 60 km/h.

Bobot (l’IA à votre service)
  1. Le Pingou

    Bonjour,

    Juste au passage le code RGB pour blanc est  (R=255,G=255,B=255)

    En principe il n'y a pas de valeur E !!!!

    0
    1. Guy72 Auteur

      Ce que je voulais, c'est avoir le fond de la couleur obtenue par la macro.
      Exemple: 

      Case Is < 91: R = 250: G = 90: B = 90

      Mais avoir le texte blanc

      Case Is < 91: R = 250: G = 90: B = 90: E = vbWhite
      0
      1. Mike-31

        Salut,

        Pas tout compris ton code ou ce que tu voulais faire. si ton shape est nommé Texte Rafale teste le code comme cela.

        Ensuite il faudra ajuster tes nuances RGB, exemple pour le noir c'est RGB(0,0,0)

        Private Sub Worksheet_Change(ByVal Target As Range)
        '- Vent en rafale ----------------------------------------------------------------------
            If Not Intersect(Target, Range("I13")) Is Nothing Then
                Shapes("Texte Rafale").Select
                    With Selection.ShapeRange.Fill
                        If [I13] > 100 Then .ForeColor.RGB = RGB(255, 55, 0)
                        If [I13] < 101 Then .ForeColor.RGB = RGB(255, 70, 50)
                        If [I13] < 91 Then .ForeColor.RGB = RGB(250, 90, 90)
                        If [I13] < 81 Then .ForeColor.RGB = RGB(167, 62, 59)
                        If [I13] < 71 Then .ForeColor.RGB = RGB(201, 196, 10)
                        If [I13] < 61 Then .ForeColor.RGB = RGB(230, 110, 10)
                        If [I13] < 51 Then .ForeColor.RGB = RGB(192, 80, 77)
                        If [I13] < 41 Then .ForeColor.RGB = RGB(250, 152, 70)
                        If [I13] < 31 Then .ForeColor.RGB = RGB(230, 180, 180)
                        If [I13] < 21 Then .ForeColor.RGB = RGB(120, 170, 220)
                        If [I13] < 11 Then .ForeColor.RGB = RGB(190, 240, 250)
                        If [I13] = 0 Then .ForeColor.RGB = RGB(0, 250, 250)
                    End With
            [I13].Select
            End If
        End Sub
         

        0
        1. Guy72 Auteur

          Voici mon code en entier.
          Mais il change la couleur du fond, mais pas le texte.
           

          Option Explicit

Dim R As Integer
Dim G As Integer
Dim B As Integer

Dim E As String

Public I18save, I22save, I12save, I13save ' Mémorisation des valeurs en publique

Sub Worksheet_Calculate()
    If [I18] <> I18save Then I18save = [I18]: Worksheet_Change ([I18]) 'Température
    If [I22] <> I22save Then I22save = [I22]: Worksheet_Change ([I22]) 'Vent Relevés
    If [I12] <> I12save Then I12save = [I12]: Worksheet_Change ([I12]) 'Soleil
    If [I13] <> I13save Then I13save = [I13]: Worksheet_Change ([I13]) 'Vent Maxi
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

'- Bouée de la température ---------------------------------------------------------------------
If Not Intersect(Target, Range("I18")) Is Nothing Then
Select Case Target.Value

Case Is < 0: R = 255: G = 51: B = 0
Case Is < 6: R = 204: G = 0: B = 153
Case Is < 11: R = 153: G = 153: B = 255
Case Is < 16: R = 51: G = 153: B = 255
Case Is < 21: R = 186: G = 224: B = 30
Case Is < 26: R = 255: G = 204: B = 153
Case Is < 31: R = 255: G = 204: B = 0
Case Is < 35: R = 255: G = 153: B = 0
Case Is < 41: R = 250: G = 190: B = 140
Case Is < 46: R = 226: G = 107: B = 10
Case Is > 51: R = 255: G = 0: B = 0

End Select
Shapes("Bouée T°").Fill.ForeColor.RGB = RGB(R, G, B)
End If

'- Bouée du Vent ----------------------------------------------------------------------
If Not Intersect(Target, Range("I22")) Is Nothing Then
Select Case Target.Value

Case Is = 0: R = 0: G = 250: B = 250
Case Is < 11: R = 190: G = 240: B = 250
Case Is < 21: R = 120: G = 170: B = 220
Case Is < 31: R = 230: G = 180: B = 180
Case Is < 41: R = 250: G = 152: B = 70
Case Is < 51: R = 192: G = 80: B = 77
Case Is < 61: R = 230: G = 110: B = 10
Case Is < 71: R = 201: G = 196: B = 10
Case Is < 81: R = 167: G = 62: B = 59
Case Is < 91: R = 250: G = 90: B = 90
Case Is < 101: R = 255: G = 70: B = 50
Case Is > 100: R = 255: G = 55: B = 0

End Select
Shapes("Bouée Vent").Fill.ForeColor.RGB = RGB(R, G, B)
End If

'- Bouée du Soleil ----------------------------------------------------------------------
If Not Intersect(Target, Range("I12")) Is Nothing Then
Select Case Target.Value
Case Is = 0: R = 166: G = 166: B = 166
Case Is < 60: R = 255: G = 255: B = 224
Case Is < 120: R = 255: G = 255: B = 192
Case Is < 180: R = 255: G = 255: B = 160
Case Is < 240: R = 255: G = 255: B = 128
Case Is < 300: R = 255: G = 255: B = 96
Case Is < 360: R = 255: G = 255: B = 64
Case Is < 420: R = 255: G = 255: B = 32
Case Is < 480: R = 255: G = 255: B = 0
Case Is >= 480: R = 255: G = 255: B = 0
End Select
Shapes("Bouée Soleil").Fill.ForeColor.RGB = RGB(R, G, B)
End If

'- Zone texte Vent en rafale ----------------------------------------------------------------------
If Not Intersect(Target, Range("I13")) Is Nothing Then
Select Case Target.Value

Case Is = 0: R = 0: G = 250: B = 250
Case Is < 11: R = 190: G = 240: B = 250
Case Is < 21: R = 120: G = 170: B = 220
Case Is < 31: R = 230: G = 180: B = 180
Case Is < 41: R = 250: G = 152: B = 70
Case Is < 51: R = 192: G = 80: B = 77
Case Is < 61: R = 230: G = 110: B = 10
Case Is < 81: R = 167: G = 62: B = 59
Case Is < 91: R = 250: G = 90: B = 90
Case Is < 101: R = 255: G = 70: B = 50
Case Is > 100: R = 255: G = 55: B = 0
End Select
Shapes("Texte Rafale").Fill.ForeColor.RGB = RGB(R, G, B)
End If
End Sub
          0
          2. Mike-31

            Re,

            Difficile de travailler sur des données partielles,

            pourquoi as tu deux shapes nommées "Bouée soleil" et "Bouée T°", es ce que tu as empilé plusieurs shapes on ne peut apprécier sur l'image de ton post 2

            0
            1. Le Pingou

              Bonjour,

              Et pourquoi ne pas mettre votre fichier à disposition avec un petit commentaire directement sur la feuille. Mettre le fichier sur https://www.cjoint.com/ et poster le lien.

              0
              2. Le Pingou

                Bonjour,

                Merci pour le fichier, la solution pour demain, patience.

                0
                1. Guy72 Auteur

                  Pas de problème
                  Bonne nuit

                  0
                  1. Mike-31

                    Re,

                    Comme l'a dit l'ami Le Pingou que je salue, demain fera jour. Mais à première vue  pour Bouée T° la cellule de déclenchement n'est pas i18 mais i20. 

                    If Not Intersect(Target, Range("I20")) Is Nothing Then

                    ensuite le fait de changer la valeur donc en I20 la bouée change de couleur..

                    Ensuite pour Bouée vent il me semble que ce n'est pas I22 mais I28

                    et Bouée soleil I24, mais pour ces deux cas tu fais référence à des cellules dont le contenu change OUI BIEN SUR mais résultat issu de formule hors pour déclencher un code il faut que le contenu change par une action manuelle sur la cellule.

                    ou il faut choisir une cellule qui inévitablement changera par une action manuelle et à partir de là tu déclenches tous les codes, ou opter pour un autre type de déclenchement.

                    0
                    1. Guy72 Auteur

                      Mais à première vue  pour Bouée T° la cellule de déclenchement n'est pas i18 mais i20. 

                      Bonjour,
                      Si c'est en i18....

                      0
                  3. Le Pingou

                    Merci, pensez de marquer comme résolu si c'est le cas.

                    0