VBA - Graphique Mise en forme intempestive

**lixil** · 23/08/2021, 17h03

Bonjour à tous,

Je rencontre des soucis de mise en forme avec des graphiques que je manipule via vba.

Dans une feuille de calcul où se trouve plusieurs graphiques, j'ai un togglebutton qui me permet de basculer entre 2 modes d'affichage.
Le premier mode affiche les données sur plusieurs années.
Le deuxième mode affiche les données sur une seule année.

Mon problème survient dans le 2ème mode.

Avant d'arriver au problème, il y a plusieurs fonctions qui s'exécutent que je vous présente ci-dessous

La fonction 1 place les graphiques sur la feuille en fonction de leur nom.

La fonction 2 insert les formules X et Y dans chaque graphique.
Formule X : =DECALER(Moyenne!$AB$2;0;Moyenne!$I$4;1;Moyenne!$I$3).
Formule Y : =DECALER(HDF!$AB$79;0;Moyenne!$I$4;1;Moyenne!$I$3)
Moyenne!$I$4 correspond à une année.
Moyenne!$I$3 correspond au nombre d'année que je veux afficher.

La fonction 3 met en forme les graphiques (Séries de données, Etiquettes de donnée, Police, Unité, hauteur, largeur etc.)

Nous arrivons dans le deuxième mode :
Je mets par défaut :
Moyenne!$I$3 = 1
Moyenne!$I$4 = "=indicateurs!A1" (indicateurs!A1 = 2016)

La mise en forme reste nickel, rien ne bouge.

Mais quand je modifie l'année (Moyenne!$I$4), le graphique modifie bien les valeurs mais au niveau de la mise en forme, plusieurs courbes deviennent bleues et les étiquettes de données disparaissent.

Je me suis assuré qu'il n'y ait pas une fonction intempestive qui s'exécute alors qu'elle ne devrait pas en faisant un test avec un point d'arrêt dans toutes les fonctions de mon document mais non tout se déroule comme prévu.

Pour palier ce problème, j'ai créé une fonction qui réapplique une nouvelle fois la mise en forme quand je change l'année (Moyenne!$I$4)
Mais même en faisant ça j'ai un truc bizarre. Il faut que j'exécute deux fois la fonction pour que la mise en forme s'applique.

Bref je ne sais plus où chercher.

Merci par avance pour vos réponses.

Lixil

**Ben_L** · 23/08/2021, 18h54

Bonjour,

En spécifiant : Moyenne!$I$4 = 2016
et en utilisant cette valeur comme 3ème argument de la fonction DECALER, vous indiquez que vous souhaitez décaler la plage Moyenne!$AB$2 de 2016 colonnes vers la droite (ce qui devrait renvoyer la cellule Moyenne!$BZP$2).

J'imagine que ce n'est pas le comportement souhaité.
Que produit votre code en corrigeant cette valeur ? Par exemple en utilisant :

Code :

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

Moyenne!$I$4 = "=indicateurs!A1 - Moyenne!$AB$2"

Par ailleurs, il va être nécessaire que vous fournissiez des parties du code que vous utilisez si vous souhaitez une aide plus précise.
Que faîtes vous des formules définies ? Quelles sont les étapes de la manipulation de vos graphiques (avec le code associé) ?

Cdt

**lixil** · 23/08/2021, 21h19

Bonjour Ben_L,

Concernant "Moyenne!$I$4 = 2016", excusez-moi je me suis trompé en écrivant le post, j'ai raisonné en année mais oui dans mon document je fais déjà bien la conversion Moyenne!$I$4 = "=indicateurs!A1 - Moyenne!$AB$2".

Ci-dessous le code du togglebutton qui permet de basculer entre les modes :

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
Private Sub ToggleButton2_Click()
 
Application.ScreenUpdating = False
 
    If Indicateurs.ToggleButton2 = True Then
    'Mode 1
        Indicateurs.Range(Indicateurs.cells(1, 1), Indicateurs.cells(2, 1)) = ""
 
        Call Recherche_Coordonnées_Intitules 'La fonction défini les valeurs de Lig_g, Col_g, Lig_h, col_h etc.
        Sheets("moyenne").cells(lig_g, col_g + 2) = 2016 - (Sheets("moyenne").cells(lig_h + 1, col_h + 1) - 1) 'Moyenne$I$4
        Sheets("moyenne").cells(lig_f, col_f + 2) = 5 'Moyenne$I$3
 
        Indicateurs.cells(2, 1).FormulaLocal = "=Valeur_Chart(C1)" 'En modifiant la cellule C1, j'appele la fonction Valeur_Chart
 
        Call MEF01_Emplacement_Chart
        Call MEF01_Chart
 
        Indicateurs.Range("K1:L2").validation.Delete
        Indicateurs.Range("K1:L2") = ""
 
    Else
    'Mode 2
        Indicateurs.Range(Indicateurs.cells(1, 1), Indicateurs.cells(2, 1)) = ""
 
        Indicateurs.Range("K1:L2").validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=offset(Moyenne!$AB$2,0,1,1,counta(Moyenne!$AC$2:$DB$2))"
 
        Indicateurs.Range("K1:L2") = 2016
 
        Call Recherche_Coordonnées_Intitules
 
        Sheets("moyenne").cells(lig_g, col_g + 2).Formulalocal = "=indicateurs!k1 - 2015"
 
        Sheets("moyenne").cells(lig_f, col_f + 2) = 1
        Indicateurs.cells(2, 1).FormulaLocal = "=Valeur_Chart(C1)"
 
    End If
 
 
Application.ScreenUpdating = True
 
End Sub

La fonction Valeur_Chart :

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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
Function Valeur_Chart(Nom_Entreprise As String)
 
Application.ScreenUpdating = False
 
Dim k As Integer
 
    If Nom_Entreprise = "" Then
        MsgBox "Veuillez saisir une entreprise"
        Exit Function
    End If
 
    ActiveSheet.ChartObjects(1).Activate
        ActiveChart.FullSeriesCollection(1).XValues = "='" & ActiveWorkbook.Name & "'!annee"
        ActiveChart.FullSeriesCollection(1).Name = "=""Résultat d'Exploitation"""
        ActiveChart.SeriesCollection(1).Values = "='" & ActiveWorkbook.Name & "'!" & Nom_Entreprise & "_RExploitation"
        ActiveChart.FullSeriesCollection(2).Name = "=""Résultat Financier"""
        ActiveChart.SeriesCollection(2).Values = "='" & ActiveWorkbook.Name & "'!" & Nom_Entreprise & "_RFinancier"
        ActiveChart.FullSeriesCollection(3).Name = "=""Résultat Courant Av. Im."""
        ActiveChart.SeriesCollection(3).Values = "='" & ActiveWorkbook.Name & "'!" & Nom_Entreprise & "_RCourant"
        ActiveChart.FullSeriesCollection(4).Name = "=""Résultat d'Exceptionnel"""
        ActiveChart.SeriesCollection(4).Values = "='" & ActiveWorkbook.Name & "'!" & Nom_Entreprise & "_RExceptionnel"
 
    ActiveSheet.ChartObjects(2).Activate
        ActiveChart.FullSeriesCollection(1).XValues = "='" & ActiveWorkbook.Name & "'!annee"
        ActiveChart.FullSeriesCollection(1).Name = "=""Résultat Net"""
        ActiveChart.SeriesCollection(1).Values = "='" & ActiveWorkbook.Name & "'!" & Nom_Entreprise & "_RNet"
 
    ActiveSheet.ChartObjects(3).Activate
        ActiveChart.FullSeriesCollection(1).XValues = "='" & ActiveWorkbook.Name & "'!annee"
        ActiveChart.FullSeriesCollection(1).Name = "=""Marge Commerciale"""
        ActiveChart.SeriesCollection(1).Values = "='" & ActiveWorkbook.Name & "'!" & Nom_Entreprise & "_MargeCom"
 
    ActiveSheet.ChartObjects(4).Activate
        ActiveChart.FullSeriesCollection(1).XValues = "='" & ActiveWorkbook.Name & "'!annee"
        ActiveChart.FullSeriesCollection(1).Name = "=""Production"""
        ActiveChart.SeriesCollection(1).Values = "='" & ActiveWorkbook.Name & "'!" & Nom_Entreprise & "_Prod"
 
    ActiveSheet.ChartObjects(5).Activate
        ActiveChart.FullSeriesCollection(1).XValues = "='" & ActiveWorkbook.Name & "'!annee"
        ActiveChart.FullSeriesCollection(1).Name = "=""Valeur Ajoutée"""
        ActiveChart.SeriesCollection(1).Values = "='" & ActiveWorkbook.Name & "'!" & Nom_Entreprise & "_VA"
 
    ActiveSheet.ChartObjects(6).Activate
        ActiveChart.FullSeriesCollection(1).XValues = "='" & ActiveWorkbook.Name & "'!annee"
        ActiveChart.FullSeriesCollection(1).Name = "=""EBE"""
        ActiveChart.SeriesCollection(1).Values = "='" & ActiveWorkbook.Name & "'!" & Nom_Entreprise & "_EBE"
 
    ActiveSheet.ChartObjects(7).Activate
        ActiveChart.FullSeriesCollection(1).XValues = "='" & ActiveWorkbook.Name & "'!annee"
        ActiveChart.FullSeriesCollection(1).Name = "=""CAF"""
        ActiveChart.SeriesCollection(1).Values = "='" & ActiveWorkbook.Name & "'!" & Nom_Entreprise & "_CAF"
 
    ActiveSheet.ChartObjects(8).Activate
        ActiveChart.FullSeriesCollection(1).XValues = "='" & ActiveWorkbook.Name & "'!annee"
        ActiveChart.FullSeriesCollection(1).Name = "=""Fonds de Roulement"""
        ActiveChart.SeriesCollection(1).Values = "='" & ActiveWorkbook.Name & "'!" & Nom_Entreprise & "_FR"
 
    ActiveSheet.ChartObjects(9).Activate
        ActiveChart.FullSeriesCollection(1).XValues = "='" & ActiveWorkbook.Name & "'!annee"
        ActiveChart.FullSeriesCollection(1).Name = "=""Besoin de Fonds de Roulement"""
        ActiveChart.SeriesCollection(1).Values = "='" & ActiveWorkbook.Name & "'!" & Nom_Entreprise & "_BFR"
 
    ActiveSheet.ChartObjects(10).Activate
        ActiveChart.FullSeriesCollection(1).XValues = "='" & ActiveWorkbook.Name & "'!annee"
        ActiveChart.FullSeriesCollection(1).Name = "=""Trésorerie Nette"""
        ActiveChart.SeriesCollection(1).Values = "='" & ActiveWorkbook.Name & "'!" & Nom_Entreprise & "_TN"
 
    ActiveSheet.ChartObjects(11).Activate
        ActiveChart.FullSeriesCollection(1).XValues = "='" & ActiveWorkbook.Name & "'!annee"
        ActiveChart.FullSeriesCollection(1).Name = "=""Taux de Marge Brute"""
        ActiveChart.SeriesCollection(1).Values = "='" & ActiveWorkbook.Name & "'!" & Nom_Entreprise & "_Taux_Marge_Brute"
 
    ActiveSheet.ChartObjects(12).Activate
        ActiveChart.FullSeriesCollection(1).XValues = "='" & ActiveWorkbook.Name & "'!annee"
        ActiveChart.FullSeriesCollection(1).Name = "=""Taux de Marge Nette"""
        ActiveChart.SeriesCollection(1).Values = "='" & ActiveWorkbook.Name & "'!" & Nom_Entreprise & "_Taux_Marge_Nette"
 
    Valeur_Chart = "Right"
 
'Permet d'actualiser l'affichage des graphiques
    For k = 1 To 12
        ActiveSheet.ChartObjects(k).Activate
    Next k
 
'Permet de désélectionner le dernier graphique activé.
    Call Unselect
 
Application.ScreenUpdating = True
 
End Function

La fonction Unselect :

Code :

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

1
2
3
4
5
Sub Unselect()
    Indicateurs.Shapes("leurre").Visible = True
    Indicateurs.Shapes("leurre").Select
    Indicateurs.Shapes("leurre").Visible = False
End Sub

la fonction MEF01_Emplacement_Chart :

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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
Sub MEF01_Emplacement_Chart()
'Mise en forme des graphiques de la feuille indicateur
Dim xRg As Range
Dim xChart As ChartObject
Dim Nom_Chart As String
Dim L As Integer, C As Integer
Dim Wdth As Double
 
    Indicateurs.Range("C1:l2").UnMerge
 
    Wdth = 10.43
    Indicateurs.Range("A:E,G:K,M:Q").ColumnWidth = Wdth
 
    Indicateurs.Range("C1:j2").Merge
    Indicateurs.Range("k1:l2").Merge
 
    i = 1
 
 
'Graphique 1
        Set xChart = Indicateurs.ChartObjects(1)
        Nom_Chart = xChart.Name
        ActiveSheet.Shapes(Nom_Chart).Line.Visible = msoFalse
        ActiveSheet.Shapes(Nom_Chart).Fill.Visible = msoFalse
        ActiveSheet.Shapes(Nom_Chart).Line.ForeColor.RGB = RGB(214, 229, 231)
        L = val(Mid(Nom_Chart, 2, 1))
        C = val(Mid(Nom_Chart, 4, 1))
 
        Set xRg = Indicateurs.Range(cells(L + 2, C), cells(L + 19, C + 4))
        xChart.Top = xRg(1).Top
        xChart.Left = xRg(1).Left
        xChart.Width = xRg.Width
        xChart.Height = xRg.Height
 
'Graphique 2
        Set xChart = Indicateurs.ChartObjects(2)
        Nom_Chart = xChart.Name
        ActiveSheet.Shapes(Nom_Chart).Line.Visible = msoFalse
        ActiveSheet.Shapes(Nom_Chart).Fill.Visible = msoFalse
        ActiveSheet.Shapes(Nom_Chart).Line.ForeColor.RGB = RGB(214, 229, 231)
        L = val(Mid(Nom_Chart, 2, 1))
        C = val(Mid(Nom_Chart, 4, 1))
 
        Set xRg = Indicateurs.Range(cells(L + 19, C), cells(L + 30, C + 4))
        xChart.Top = xRg(1).Top
        xChart.Left = xRg(1).Left
        xChart.Width = xRg.Width
        xChart.Height = xRg.Height
 
'Graphique 3 à 10
    For i = 3 To 10
 
        Set xChart = Indicateurs.ChartObjects(i)
        Nom_Chart = xChart.Name
        ActiveSheet.Shapes(Nom_Chart).Line.Visible = msoFalse
        ActiveSheet.Shapes(Nom_Chart).Fill.Visible = msoFalse
        ActiveSheet.Shapes(Nom_Chart).Line.ForeColor.RGB = RGB(214, 229, 231)
        L = val(Mid(Nom_Chart, 2, 1))
        C = val(Mid(Nom_Chart, 4, 1))
 
        Set xRg = Indicateurs.Range(cells(L + 2 + (L - 1) * 5, C + (C - 1) * 5), cells(L + 2 + (L - 1) * 5 + 5, C + (C - 1) * 5 + 4))
        xChart.Top = xRg(1).Top
        xChart.Left = xRg(1).Left
        xChart.Width = xRg.Width
        xChart.Height = xRg.Height
 
    Next i
 
'Graphique 11 et 12
    For i = 11 To 12
        Set xChart = Indicateurs.ChartObjects(i)
        Nom_Chart = xChart.Name
        ActiveSheet.Shapes(Nom_Chart).Line.Visible = msoFalse
        ActiveSheet.Shapes(Nom_Chart).Fill.Visible = msoFalse
'        ActiveSheet.Shapes(Nom_Chart).Line.ForeColor.RGB = RGB(214, 229, 231)
        L = val(Mid(Nom_Chart, 2, 1))
        C = val(Mid(Nom_Chart, 4, 1))
 
        Set xRg = Indicateurs.Range(cells(L + (L - 1) * 5 + (L - 1), C + (C - 1) * 5), cells(L + (L - 1) * 5 + 5 + (L - 1), C + (C - 1) * 5 + 4))
        xChart.Top = xRg(1).Top
        xChart.Left = xRg(1).Left
        xChart.Width = xRg.Width
        xChart.Height = xRg.Height
 
    Next i
 
    Call Unselect
 
End Sub

La fonction MEF01_Chart :

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
Sub MEF01_Chart()
 
    Gap_Bleu = 160
    Gap_Vert = 70
    Gap_Rouge = 75
 
    If ActiveSheet.CodeName <> "Indicateurs" Then
        Exit Sub
    End If
 
    For i = 1 To 12
 
        Set xChart = Indicateurs.ChartObjects(i)
 
        Nom_Chart = xChart.Name
        Indicateurs.ChartObjects(Nom_Chart).Activate
 
        Call Reglage_Echelle
        Call Reglage_Zone_De_Tracage
        Call Reglage_Etiquettes_De_Donnees
        Call Reglage_Format_Nombre
 
 
        Couleur = val(Mid(Nom_Chart, 8, 1))
        Call Reglage_Couleur
 
        Call Reglage_Serie_De_Données
 
    Next i
 
 
    Call Unselect
 
End Sub

La fonction Reglage_Echelle

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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
Sub Reglage_Echelle()
 
'Valeur max 'Valeur min
    VMax = WorksheetFunction.Max(ActiveChart.SeriesCollection(1).Values)
    VMin = WorksheetFunction.Min(ActiveChart.SeriesCollection(1).Values)
 
    If ActiveChart.SeriesCollection.count >= 2 Then
 
        For j = 2 To ActiveChart.SeriesCollection.count
            If VMax < WorksheetFunction.Max(ActiveChart.SeriesCollection(j).Values) Then
                VMax = WorksheetFunction.Max(ActiveChart.SeriesCollection(j).Values)
            End If
            If VMin > WorksheetFunction.Min(ActiveChart.SeriesCollection(j).Values) Then
                VMin = WorksheetFunction.Min(ActiveChart.SeriesCollection(j).Values)
            End If
        Next
 
    End If
 
 
        If VMin >= 0 Then
            VMin = 0
        ElseIf VMax <= 0 Then
            VMax = 0
        End If
 
'format des nombres de l'axe Y
        If Abs(VMax) > Abs(VMin) Then
            VAbs = Abs(VMax)
        Else
            VAbs = Abs(VMin)
        End If
 
        If VAbs > 1000000000 Then
            ActiveChart.Axes(xlValue).HasDisplayUnitLabel = True
            ActiveChart.Axes(xlValue).DisplayUnit = xlThousandMillions
            Unité = 1000000000
 
        ElseIf VAbs > 1000000 Then
            ActiveChart.Axes(xlValue).HasDisplayUnitLabel = True
            ActiveChart.Axes(xlValue).DisplayUnit = xlMillions
            Unité = 1000000
 
        ElseIf VAbs > 1000 Then
            ActiveChart.Axes(xlValue).HasDisplayUnitLabel = True
            ActiveChart.Axes(xlValue).DisplayUnit = xlThousands
            Unité = 1000
 
        Else
            ActiveChart.Axes(xlValue).HasDisplayUnitLabel = False
            ActiveChart.Axes(xlValue).DisplayUnit = xlNone
            Unité = 1
        End If
 
'graduation y
        ActiveChart.Axes(xlValue).MinimumScaleIsAuto = True
        ActiveChart.Axes(xlValue).MaximumScaleIsAuto = True
        ActiveChart.Axes(xlValue).MajorUnitIsAuto = True
 
End Sub

La fonction Reglage_Zone_De_Tracage

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
43
44
45
46
Sub Reglage_Zone_De_Tracage()
 
'Mise en forme de la zone de tracage
    VMax = ActiveChart.Axes(xlValue).MaximumScale
    VMin = ActiveChart.Axes(xlValue).MinimumScale
 
    If Abs(VMax) > Abs(VMin) Then
        VAbs = Abs(VMax)
    Else
        VAbs = Abs(VMin)
    End If
 
    If VAbs / Unité >= 1000 Then
        Up = 16
    ElseIf VAbs / Unité >= 100 Then
        Up = 9
    ElseIf VAbs / Unité >= 10 Then
        Up = 4
    Else
        Up = 0
    End If
 
    If i = 1 Then
        ActiveChart.PlotArea.Width = 10
        ActiveChart.PlotArea.Height = 10
        ActiveChart.PlotArea.Left = 30 - Up
        ActiveChart.PlotArea.Top = 60
        ActiveChart.PlotArea.Width = 350
        ActiveChart.PlotArea.Height = 240
    ElseIf i = 2 Then
        ActiveChart.PlotArea.Width = 10
        ActiveChart.PlotArea.Height = 10
        ActiveChart.PlotArea.Left = 30 - Up
        ActiveChart.PlotArea.Top = 30
        ActiveChart.PlotArea.Width = 350
        ActiveChart.PlotArea.Height = 160
    ElseIf i >= 3 Then
        ActiveChart.PlotArea.Width = 10
        ActiveChart.PlotArea.Height = 10
        ActiveChart.PlotArea.Left = 30 - Up
        ActiveChart.PlotArea.Top = 30
        ActiveChart.PlotArea.Width = 350
        ActiveChart.PlotArea.Height = 60
    End If
 
End Sub

La fonction Reglage_Etiquettes_De_Donnees

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
Sub Reglage_Etiquettes_De_Donnees()
 
'Ajout + Mise en forme des étiquettes de données
    For j = 1 To ActiveChart.SeriesCollection.count
        ActiveChart.ApplyDataLabels
        ActiveChart.FullSeriesCollection(j).DataLabels.Select
        Selection.NumberFormat = "# ##0,00"
 
        If i = 11 Or i = 12 Then
            Selection.NumberFormat = "0,00%"
            ActiveChart.Axes(xlValue).TickLabels.NumberFormat = "0,00%"
        End If
    Next j
 
End Sub

La fonction Reglage_Format_Nombre

Code :

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

1
2
3
4
5
Sub Reglage_Format_Nombre()
 
    ActiveChart.Axes(xlValue).TickLabels.NumberFormat = "#*##0,00"
 
End Sub

La fonction Reglage_Couleur

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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
Sub Reglage_Couleur()
 
'Couleur unité (Millions, milliers etc.)
        If ActiveChart.Axes(xlValue).HasDisplayUnitLabel = True Then
            ActiveChart.Axes(xlValue).DisplayUnitLabel.Font.ColorIndex = Couleur
        End If
 
'couleur valeur unité Y
        ActiveChart.Axes(xlValue).TickLabels.Font.ColorIndex = Couleur
 
'Couleur titre graphique
        If ActiveChart.HasTitle Then
            ActiveChart.ChartTitle.Font.ColorIndex = Couleur
        End If
 
        For j = 1 To ActiveChart.SeriesCollection.count
 
            Rouge = Int(ActiveChart.Axes(xlValue).TickLabels.Font.Color Mod 256)
            If Rouge + Gap_Rouge * (j - 1) < 250 And (j - 1) > 0 Then
                Rouge = Rouge + Gap_Rouge * (j - 1)
            ElseIf (j - 1) > 0 Then
                Rouge = 0
            End If
 
            Vert = Int((ActiveChart.Axes(xlValue).TickLabels.Font.Color Mod 65536) / 256) + 30 * (j - 1) * (j - 2)
            If Vert + Gap_Vert * (j - 1) * (j - 2) < 250 And (j - 1) > 0 Then
                Vert = Vert + Gap_Vert * (j - 1)
            ElseIf (j - 1) > 0 Then
                Vert = 0
            End If
 
            Bleu = Int(ActiveChart.Axes(xlValue).TickLabels.Font.Color / 65536)
            If Bleu + Gap_Bleu * (j - 1) < 250 And (j - 1) > 0 Then
                Bleu = Bleu + Gap_Bleu * (j - 1)
            ElseIf (j - 1) > 0 Then
                Bleu = 0
            End If
 
'couleur des ombres du graphique
'Paramètre ombre des barres du graphique
            ActiveChart.FullSeriesCollection(j).Format.Shadow.Type = msoShadow31
            ActiveChart.FullSeriesCollection(j).Format.Shadow.Style = msoShadowStyleInnerShadow
            ActiveChart.FullSeriesCollection(j).Format.Shadow.Transparency = 0.5
            ActiveChart.FullSeriesCollection(j).Format.Shadow.Blur = 9
            ActiveChart.FullSeriesCollection(j).Format.Shadow.OffsetX = 0
            ActiveChart.FullSeriesCollection(j).Format.Shadow.OffsetY = 0
            ActiveChart.FullSeriesCollection(j).Format.Shadow.ForeColor.RGB = RGB(Rouge, Vert, Bleu)
 
'Couleur étiquettes de données
            ActiveChart.FullSeriesCollection(j).DataLabels.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(Rouge, Vert, Bleu)
 
            If ActiveChart.HasLegend Then
                ActiveChart.Legend.LegendEntries(j).Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(Rouge, Vert, Bleu)
            End If
 
'couleur des barres du graphique
'            ActiveChart.FullSeriesCollection(j).Interior.ColorIndex = Couleur
            ActiveChart.FullSeriesCollection(j).Format.Fill.ForeColor.RGB = RGB(Rouge, Vert, Bleu)
 
    Next
 
'couleur du quadrillage
        ActiveChart.Axes(xlValue).MajorGridlines.Border.ColorIndex = Couleur
 
'couleur de l'abscisse
        ActiveChart.Axes(xlCategory).Border.ColorIndex = Couleur
 
'couleur de l'ordonnée
        ActiveChart.Axes(xlValue).Border.ColorIndex = Couleur
 
End Sub

La fonction Reglage_Serie_De_Données

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
Sub Reglage_Serie_De_Données()
 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    For j = 1 To ActiveChart.SeriesCollection.count
 
'Style des barres du graphique
        ActiveChart.FullSeriesCollection(j).Format.Fill.Patterned msoPatternNarrowHorizontal
 
    Next
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
'Transparence du quadrillage
        ActiveChart.Axes(xlValue).MajorGridlines.Format.Line.Transparency = 0.8
 
'epaisseur de l'abscisse
        ActiveChart.Axes(xlCategory).Format.Line.Weight = 1.75
 
'epaisseur de l'ordonnée
        ActiveChart.Axes(xlValue).Format.Line.Weight = 1.75
 
End Sub

Voilà tout les bouts de code que j'utilise que j'ai en grande partie découvert sur ce forum

. Je pense n'avoir rien oublié. Tout n'est peut-être pas optimisé mais j'y travaille.

**lixil** · 24/08/2021, 11h35

Mais c'est même pas un problème de codage vba en faite car j'ai créé un nouveau fichier au format xlsx sans macro.

Dans la plage de cellule "C1:G2" :
- J'ai mis des années dans la première ligne (2015 à 2019)
- J'ai mis des valeurs aléatoires dans la deuxième ligne ( 4, 5, 6, 7, 8)

J'ai mis A1 = 0 (Colonne de départ)
J'ai mis A2 = 5 (Nombre de colonne)

J'ai créé 2 Noms avec les formules suivantes :
Annee =DECALER(Feuil1!$C$1;0;Feuil1!$A$1;1;Feuil1!$A$2),
Valeur =DECALER(Feuil1!$C$2;0;Feuil1!$A$1;1;Feuil1!$A$2).

J'ai créé un graphique à barre avec :
en Y = 'test.xlsx'!Valeur,
en X = 'test.xlsx'!Annee.

J'ai modifié la couleurs des barres du graphique. je les ai mises en vert.

Ensuite en modifiant les valeurs des cellules A1 et A2, la couleur change et redevient bleue. (La couleur par défaut)

**Philippe Tulliez** · 24/08/2021, 12h44

Bonjour,
Je ne sais pas si j'ai bien compris votre problème mais personnellement, je n'ai pas de problème de mise en forme même après avoir modifié la couleur des barres
J'ai utilisé le contrôle de formulaire Barre de défilement pour décaler les données

Nom : Graphique avec DECALER.png
Affichages : 63
Taille : 18,0 Ko

Nom : Graphique avec DECALER.png
Affichages : 63
Taille : 18,0 Ko

**lixil** · 24/08/2021, 13h14

Bonjour Philippe Tulliez,

J'ai téléchargé votre document et ça le fait également.

J'ai positionné le curseur de votre barre de défilement à gauche.
Cellule A1 => 0
Cellule A2 => =COLONNES(D1:I1)-A1 => 6

J'ai supprimé la formule que vous avez mis en A2 et j'ai mis 1
Cellule A1 => 0
Cellule A2 => 1

Le graphique affiche l'année 2015 dans la bonne mise en forme.

Nom : Image2.png
Affichages : 67
Taille : 168,8 Ko

Nom : Image2.png
Affichages : 67
Taille : 168,8 Ko

Mais ensuite en faisant défiler les années (une par une) jusque 2020 avec la barre de défilement, les barres se mettent automatiquement en bleu.

Nom : Image3.png
Affichages : 64
Taille : 95,0 Ko

Nom : Image3.png
Affichages : 64
Taille : 95,0 Ko

Pour finir, j'ai remis la formule en A2 (=COLONNES(D1:I1)-A1) et j'ai 2 barres avec les bonnes couleurs et les autres sont bleues.

Nom : Image4.png
Affichages : 63
Taille : 98,2 Ko

Nom : Image4.png
Affichages : 63
Taille : 98,2 Ko

**Ben_L** · 24/08/2021, 14h50

Bonjour tout le monde !

Avant de modifier vos graphiques, utilisez le code :

Code :

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

1
2
Application.ChartDataPointTrack = False
ThisWorkbook.ChartDataPointTrack = False

Puis, une fois toutes les modifs effectuées :

Code :

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

1
2
Application.ChartDataPointTrack = True
ThisWorkbook.ChartDataPointTrack = True

Selon votre besoin, vous pouvez remplacer ThisWorkbook par ActiveWorkbook ou tout autre variable ou méthode renvoyant un objet Workbook.

Cdt

**lixil** · 24/08/2021, 15h55

Bonjour Ben_L,

Je vous communique mes premiers résultats, je suis encore en train de tester.
Il y a du mieux, j'ai inséré les instructions dans la fonction MEF01_Chart, je vous remet la fonction ci-dessous :

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
Sub MEF01_Chart()
 
    Gap_Bleu = 160
    Gap_Vert = 70
    Gap_Rouge = 75
 
    If ActiveSheet.CodeName <> "Indicateurs" Then
        Exit Sub
    End If
 
    For i = 1 To 12
 
        Application.ChartDataPointTrack = False
        ThisWorkbook.ChartDataPointTrack = False
 
        Set xChart = Indicateurs.ChartObjects(i)
 
        Nom_Chart = xChart.Name
        xChart.Activate
 
        Couleur = val(Mid(Nom_Chart, 8, 1))
 
        Call Reglage_Echelle
        Call Reglage_Zone_De_Tracage
        Call Reglage_Etiquettes_De_Donnees
        Call Reglage_Format_Nombre
        Call Reglage_Couleur
        Call Reglage_Serie_De_Données
 
 
        Application.ChartDataPointTrack = True
        ThisWorkbook.ChartDataPointTrack = True
 
    Next i
 
 
    Call Unselect
 
 
End Sub

Rendu Mode 1 :

Nom : Image1.png
Affichages : 65
Taille : 224,2 Ko

Rendu Mode 2 : 2016 est la valeur par défaut

Nom : Image2.png
Affichages : 61
Taille : 179,1 Ko

Rendu Mode 2 quand je change l'année

Nom : Image3.png
Affichages : 80
Taille : 152,5 Ko

Sans les 4 lignes de code que vous m'avez indiqué aujourd'hui voila ce qui s'affiche :

Nom : Image6.png
Affichages : 59
Taille : 113,3 Ko

Il y a du mieux mais quelques graphiques font encore de la résistance.
De plus j'ai l'impression que le code met un plus de temps à s'exécuter.

**Ben_L** · 24/08/2021, 16h05

Il semblerait préférable d'intégrer lesdites lignes au début et à la fin de la procédure ToggleButton2_Click().
En effet actuellement, la fonction Valeur_Chart modifie les graphiques alors que les propriétés ChartDataPointTrack n'ont pas été adaptées.

Concernant la consommation de ressources, je ne puis que vous conseiller d'éviter les activations/sélections.

**lixil** · 24/08/2021, 16h23

Alors à la première tentative j'avais mis ces lignes au début et à la fin de la fonction MEF01_Chart mais ça n'avait rien changé.
C'est pourquoi j'ai essayé de les insérer dans la boucle for de la fonction MEF01_Chart et où j'ai pu constaté une amélioration.

En mettant ces instructions dans le togglebutton, je reviens au point de départ...

Concernant les activations/sélections, vous n'avez que trop raison. En plus j'ai déjà lu des posts qui allaient dans ce sens (plusieurs fois)

.
Je vais revoir tous mes codes pour les alléger au maximum une fois que ce problème sera résolu.

**lixil** · 24/08/2021, 18h36

Bon ... En tout cas, sur un cas simple, ces 4 lignes de code sont la solution.

J'ai repris le fichier de M. Philippe Tulliez avec en plus 2 bouton de commande.
1 bouton avec les 2 lignes ChartDataPointTrack = False
et 1 bouton avec les 2 lignes ChartDataPointTrack = true

En mettant ChartDataPointTrack = False, la mise en forme ne bouge pas.

Je vous remercie pour la solution, et également pour le temps que vous m'avez consacré.

Bien cordialement.

Lixil

VBA - Graphique Mise en forme intempestive [XL-2016]

Excel

Discussions similaires

Partager

Partager