Etiquette dynamique vba excel

Bonjour,

j'ai besoin d'un script vba excel qui permet de colorer automatiquement les etiquettes d'un histogramme selon les valeurs
rouge si négative
vert si positive

3 réponses

  • Votes
  • Date
  • Date décroissante
  1. Bonjour,

    pour le vert, voir en fonction version excel

    'Code original sur site: http://www.excelabo.net/excel/couleurs_graph_condition
    'code modifie pour couleur etiquetes
    Sub FormatConditionnelGraphique_etiquete()
        Dim couleur As Boolean
        
        'Compte le nombre de séries
        For C = 1 To ActiveChart.SeriesCollection.Count
            'compte le nombre de points
            For d = 1 To ActiveChart.SeriesCollection(C).Points.Count
                'teste la présente des étiquettes sur le graphs
                If ActiveChart.SeriesCollection(C).Points(d).HasDataLabel = False Then test = 1
                'affiche les étiquettes
                ActiveChart.SeriesCollection(C).Points(d).HasDataLabel = True
                'récupère les informations des étiquettes
                rep = ActiveChart.SeriesCollection(C).Points(d).DataLabel.Text
                
                'convertit l'étiquette en nombre et fais le test
                If CDbl(rep) > 0 Then
                    'suivant le résultat, change la couleur
                    couleur = True
                Else
                    couleur = False
                End If
                ActiveChart.SeriesCollection(C).Points(d).DataLabel.Select
                With Selection.Format.TextFrame2.TextRange.Font.Fill
                    .Visible = msoTrue
                    .Transparency = 0
                    .Solid
                    If couleur Then
                        .ForeColor.RGB = RGB(0, 176, 80)
                    Else
                        .ForeColor.RGB = RGB(255, 0, 0)
                    End If
                End With
                'remets dans l'état initial le graphique
                If test = 1 Then ActiveChart.SeriesCollection(C).Points(d).HasDataLabel = False
            Next d
        Next C
    End Sub
    1. Merci mais ca marche pas ,

      j'ai essayé de developper ce code mais ca buge au niveau de la ligne 8

      Sub Macro3()
      Dim cht As Chart, tablo
      Set cht = ActiveSheet.ChartObjects("Graphique 1").Chart
      With cht.SeriesCollection(2)
      tablo = .Values
      For i = 1 To UBound(tablo)
      If tablo(i) > 0 Then
      .Points(i).DataLabel.Interior.ColorIndex = 4
      Else
      .Points(i).DataLabel.Interior.ColorIndex = 3
      End If
      Next
      End With
      End Sub