Couleurs de graphiques conditionnées - Propriété ou méthode non supportée

**pimpom81** · 17/01/2020, 08h28

Bonjour le forum,

J'ai un point bloquant lors de l'éxécution d'un Private sub dans un userform, pour changer la couleur des barres de graphique de barres empilées suivant les valeurs.
Lors de l'éxécution de celui-ci j'ai un essage d'erreur "438 - Propriété ou méthode non supportée".

NB : Mes variables "Ch", "i", "Wb1" et "Ws1" sont déclarées en public dans le module de classe.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Private Sub Chart_Activate()
 
Set Wb1 = Workbooks("Book1.xlsb")
Set Ws2 = Wb1.Worksheets("Sheet 1")
 
Application.ScreenUpdating = False
 
Set Ch = Worksheets("Charts").ChartObjects("Participation").Chart
 
With Ch
    With .SeriesCollection(1)
        For i = 1 To .Points.Count
            If .SeriesCollection(1).Value >= 2 Then
                .Points(i).ForeColor.RGB = RGB(0, 176, 80)
            ElseIf .SeriesCollection(1).Value = 1 Then
                .Points(i).ForeColor.RGB = RGB(255, 153, 51)
            ElseIf .SeriesCollection(1).Value = 0 Then
                .SetElement (msoElementDataLabelCenter)
                With Selection.Format.TextFrame2.TextRange.Font.Fill
                    .Visible = msoTrue
                    .ForeColor.RGB = RGB(255, 0, 0)
                    .Transparency = 0
                    .Solid
                End With
                Selection.Format.TextFrame2.TextRange.Font.Italic = msoTrue
            End If
        Next i
    End With
    With .FullSeriesCollection(2).Select
        With Selection.Format.Line
            .Visible = msoTrue
            .ForeColor.RGB = RGB(0, 112, 192)
            .Transparency = 0
        End With
    End With
End With
End Sub

L'objet du Private sub est de modifier les couleurs des barres du graphique supérieures ou égales 2 en Vert, égales à 1 en Orange et égales à 0 afficher les données et les formater.

Les données sont issues d'un tableau situé sur une autre feuille.

Merci par avance pour votre participation.

**Menhir** · 17/01/2020, 08h44

Envoyé par pimpom81

Lors de l'éxécution de celui-ci j'ai un essage d'erreur "438 - Propriété ou méthode non supportée".

Quelle est la ligne désignée par le débugage ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
With Ch
    With .SeriesCollection(1)
        For i = 1 To .Points.Count
            If .SeriesCollection(1).Value >= 2 Then

Je pense que le second .SeriesCollection(1) n'est pas convenable puisqu'il est membre de ... .SeriesCollection(1).
Il est probable que tu as oublié de corriger cette ligne quand tu as mis en place le second With.

Idem dans les lignes suivantes.

**pimpom81** · 17/01/2020, 10h25

Bonjour Menhir,

Le débugage désigne la ligne 13.

**Menhir** · 17/01/2020, 11h41

Envoyé par pimpom81

Le débugage désigne la ligne 13.

Voir la fin de mon message précédent.

**pimpom81** · 17/01/2020, 12h01

J'ai le même message d'erreur avec la correction suivante, d'après la réponse de Menhir.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
With Ch
    With .SeriesCollection(1)
        For i = 1 To .Points.Count
            If .Value >= 2 Then

**Phil Free** · 17/01/2020, 13h00

Bonjour le file,

. value n'est pas une propriété de SeriesCollection !!!

pour travailler avec les valeurs des points c'est un peu plus compliqué car on ne peu pas non plus passer par l'objet point.
Les valeurs sont associées à la seriescollection sous la forme d'un tableau de type array.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub demo()
Dim SerieValues As Variant, i As Long
 
SerieValues = ActiveChart.SeriesCollection(1).Values 'ceci va dimensionner en variable tableau la variable SerieValues
 
For i = 1 To UBound(SerieValues)
    Debug.Print SerieValues(i)
Next
End Sub

**pimpom81** · 17/01/2020, 14h20

Merci Phil Free,

J'ai adapté mon code avec tes indications et j'ai les bonnes couleurs qui s'affichent.

Cette fois-ci je n'arrive pas a afficher les étiquettes de données si la valeur est égal à 0. (Lignes de code 15 à 25)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
With Ch
    With .SeriesCollection(1)
        For i = 1 To UBound(SerieValues)
            Debug.Print SerieValues(i)
            If SerieValues(i) >= 2 Then
                Ch.SeriesCollection(1).Points(i).Select
                With Selection.Format.Fill
                    .ForeColor.RGB = RGB(0, 176, 80)
                End With
            ElseIf SerieValues(i) = 1 Then
                Ch.SeriesCollection(1).Points(i).Select
                With Selection.Format.Fill
                    .ForeColor.RGB = RGB(255, 153, 51)
                End With
            ElseIf SerieValues(i) = 0 Then
                Ch.SeriesCollection(1).Points(i).Select
                Ch.SetElement (msoElementDataLabelCenter)
                Ch.SeriesCollection(1).Points(i).DataLabel.Select
                With Selection.Format.TextFrame2.TextRange.Font.Fill
                    .Visible = msoTrue
                    .ForeColor.RGB = RGB(255, 0, 0)
                    .Transparency = 0
                    .Solid
                End With
                Selection.Format.TextFrame2.TextRange.Font.Italic = msoTrue
            End If
        Next i
    End With
    With .FullSeriesCollection(2).Select
        With Selection.Format.Line
            .Visible = msoTrue
            .ForeColor.RGB = RGB(0, 112, 192)
            .Transparency = 0
        End With
    End With
End With

**Phil Free** · 20/01/2020, 15h51

Bonjour,

je ne sais pas si tu as résolu ton problème. je ne vois pas d’où cela peu venir.
Je te propose de plutôt faire comme suit pour travailler et afficher les datalabels.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Dim MonPoint As Point 'ajoute cette déclaration
 
      With ch
        With .SeriesCollection(1)
            SerieValues = .Values
            For i = 1 To UBound(SerieValues)
                Debug.Print SerieValues(i)
                .Points(i).Select
                Set MonPoint = Selection
                With MonPoint
                    If .HasDataLabel = False Then .HasDataLabel = True 'ici on s'assure de travailler sur un datalabel affiché
                    If SerieValues(i) >= 2 Then
                        .Format.Fill.ForeColor.RGB = RGB(0, 176, 80)
                    ElseIf SerieValues(i) = 1 Then
                        .Format.Fill.ForeColor.RGB = RGB(255, 153, 51)
                    ElseIf SerieValues(i) = 0 Then
                        ch.SetElement (msoElementDataLabelCenter)
                        .DataLabel.Select
                        With Selection.Format.TextFrame2.TextRange.Font.Fill
                            '.Visible = msoTrue
                            .ForeColor.RGB = RGB(255, 0, 0)
                            .Transparency = 0
                            .Solid
                        End With
                        Selection.Format.TextFrame2.TextRange.Font.Italic = msoTrue
                    End If
                End With
            Next i
        End With
        With .FullSeriesCollection(2).Select
            With Selection.Format.Line
                .Visible = msoTrue
                .ForeColor.RGB = RGB(0, 112, 192)
                .Transparency = 0
            End With
        End With
    End With

**pimpom81** · 20/01/2020, 22h23

Bonjour Phil,

Le résultat sur les couleurs est résolu, par contre le résultat sur les étiquettes pas tout à fait.
J'ai repris ton code, mais malheureusement ce sont les étiquettes des valeurs 1 et >= à 2 qui s'affichent alors que je souhaite que ce ne soit que les valeurs = à 0 en rouge, gras et italique et masquer les autres valeurs.

**Phil Free** · 21/01/2020, 13h18

le même code avec 2 ligne en plus :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Dim MonPoint As Point 'ajoute cette déclaration
 
      With ch
        With .SeriesCollection(1)
            SerieValues = .Values
            For i = 1 To UBound(SerieValues)
                Debug.Print SerieValues(i)
                .Points(i).Select
                Set MonPoint = Selection
                With MonPoint
                    If .HasDataLabel = False Then .HasDataLabel = True 'ici on s'assure de travailler sur un datalabel affiché.
                    If SerieValues(i) >= 2 Then
                        .Format.Fill.ForeColor.RGB = RGB(0, 176, 80)
                        .HasDataLabel = False 
                    ElseIf SerieValues(i) = 1 Then
                        .Format.Fill.ForeColor.RGB = RGB(255, 153, 51)
                        .HasDataLabel = False
                    ElseIf SerieValues(i) = 0 Then
                        ch.SetElement (msoElementDataLabelCenter)
                        .DataLabel.Select
                        With Selection.Format.TextFrame2.TextRange.Font.Fill
                            '.Visible = msoTrue
                            .ForeColor.RGB = RGB(255, 0, 0)
                            .Transparency = 0
                            .Solid
                        End With
                        Selection.Format.TextFrame2.TextRange.Font.Italic = msoTrue
                    End If
                End With
            Next i
        End With
        With .FullSeriesCollection(2).Select
            With Selection.Format.Line
                .Visible = msoTrue
                .ForeColor.RGB = RGB(0, 112, 192)
                .Transparency = 0
            End With
        End With
    End With

A+

**pimpom81** · 21/01/2020, 14h17

Bonjour Phil

J'ai un message d'erreur 438 sur la ligne 19 car ma première valeur est égale à 1.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
With Ch
    With .SeriesCollection(1)
        For i = 1 To UBound(SerieValues)
            Debug.Print SerieValues(i)
            .Points(i).Select
            Set MyPoint = Selection
            With MyPoint
                If .HasDataLabel = False Then .HasDataLabel = True
                If SerieValues(i) >= 2 Then
                    Ch.SeriesCollection(1).Points(i).Select
                    With Selection.Format.Fill
                        .ForeColor.RGB = RGB(0, 176, 80)
                        .HasDataLabel = False
                    End With
                ElseIf SerieValues(i) = 1 Then
                    Ch.SeriesCollection(1).Points(i).Select
                    With Selection.Format.Fill
                        .ForeColor.RGB = RGB(255, 153, 51)
                        .HasDataLabel = False
                    End With
                ElseIf SerieValues(i) = 0 Then
                    Ch.SetElement (msoElementDataLabelCenter)
                    .DataLabel.Select
                    With Selection.Format.TextFrame2.TextRange.Font.Fill
                        .Visible = msoTrue
                        .ForeColor.RGB = RGB(255, 0, 0)
                        .Transparency = 0
                        .Solid
                    End With
                    Selection.Format.TextFrame2.TextRange.Font.Italic = msoTrue
                End If
            End With
        Next i
    End With
    With .FullSeriesCollection(2).Select
        With Selection.Format.Line
            .Visible = msoTrue
            .ForeColor.RGB = RGB(0, 112, 192)
            .Transparency = 0
        End With
    End With
End With

**Phil Free** · 21/01/2020, 16h08

non non non

voici une partie du dernier code que j'ai posté :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
                    If SerieValues(i) >= 2 Then
                        .Format.Fill.ForeColor.RGB = RGB(0, 176, 80)
                        .HasDataLabel = False 
                    ElseIf SerieValues(i) = 1 Then
                        .Format.Fill.ForeColor.RGB = RGB(255, 153, 51)
                        .HasDataLabel = False

et voici ce que tu as posté :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
                If SerieValues(i) >= 2 Then
                    Ch.SeriesCollection(1).Points(i).Select
                    With Selection.Format.Fill
                        .ForeColor.RGB = RGB(0, 176, 80)
                        .HasDataLabel = False
                    End With
                ElseIf SerieValues(i) = 1 Then
                    Ch.SeriesCollection(1).Points(i).Select
                    With Selection.Format.Fill
                        .ForeColor.RGB = RGB(255, 153, 51)
                        .HasDataLabel = False
                    End With

l'erreur 438 est du au fait que tu associes .HasDataLabel = False a Selection.Format.Fill via le with.
de plus du fait de la ligne With MyPoint les lignes Ch.SeriesCollection(1).Points(i).Select ne servent plus à rien

c'est pour cela que j'ai réécrit cette partie en remplaçant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Ch.SeriesCollectionCollection(1).Points(i).Select
With Selection.Format.Fill
      .ForeColor.RGB = RGB(xxx, xxx, xxx)
      .HasDataLabel = False

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
.Format.Fill.ForeColor.RGB = RGB(xxx, xxx, xxx)
.HasDataLabel = False

**pimpom81** · 21/01/2020, 16h32

L'affichage est obtenu, mais pas la police Gras, Italique et Rouge pour la valeur 0

On y vient, on y vient

Couleurs de graphiques conditionnées - Propriété ou méthode non supportée

Macros et VBA Excel

Discussions similaires

Partager

Partager