Etiquette dynamique vba excel

kd13 Messages postés 102 Statut Membre -  
f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   -
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

  1.
    f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    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
    0
  2. kd13 Messages postés 102 Statut Membre 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
    0
  3. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Re,

    Chez moi, ca marche !!!

    Quelle erreur avez-vous ????
    0