Etiquette dynamique vba excel

kd13 Messages postés 102 Statut Membre -  
f894009 Messages postés 17416 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

A voir également:

3 réponses

Réponse 1 / 3
f894009 Messages postés 17416 Date d'inscription   Statut Membre Dernière intervention   1 715
 
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
Réponse 2 / 3
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
Réponse 3 / 3
f894009 Messages postés 17416 Date d'inscription   Statut Membre Dernière intervention   1 715
 
Re,

Chez moi, ca marche !!!

Quelle erreur avez-vous ????
0