MAJ Graphique grâce à une macro

**ludo01** · 18/05/2015, 12h57

Bonjour à toutes et à tous,

Je débute sous excel et j'ai besoin d'un coup de main.
Non sans mal, j'ai créé un tableau de suivi sous forme de calendrier qui fonctionne parfaitement aujourd'hui.
Il suffit de cliquer sur les flèches pour sélectionner l'année et de saisir le mois en C4.

Les samedis, dimanches sont grisés et les jours fériés sont en rose car non travaillés.

Au départ, je saisissais chaque mois de l'année les séries de données pour mettre à jour mon graphique (uniquement les jours de la colonne A) Dans le fichier joint j'ai laissé uniquement le graph correspondant à la colonne "TOTAL" car dans mon fichier final il y en aura 5 par feuille (A,B,C,D et TOTAL).

On m'a aidé à créer une macro qui permet de mettre à jour ce graphique en un clic sur le bouton "MAJ GRAPH"
Le pb c'est que l'abscisse de ce graph est figé sur une base de 23 jours.

Je voudrai qu'elle soit variable et là mes compétences s'arrêtent.....

Merci de votre aide.

**joe.levrai** · 18/05/2015, 17h09

Bonjour,

voici ton code retravaillé et ajustant l'abscisse en fonction du nombre de valeurs

La procédure :

- met à jour ton tableau source comme auparavant
- supprime TOUT les graphiques qui seraient dans la feuille
- recrée un graphique avec les nouvelles données
- le positionne et le dimensionne sur la plage B43:R60

c'était ce que tu voulais ?

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
Sub Graph()
 
Dim Plage As Range
Dim Courbe As ChartObject
 
With Sheets("CA Jour")
    .Range("b62:d92").ClearContents
    lig = 11
    Pos = 62
    Application.Calculation = xlManual
 
    Do While .Cells(lig, "A").Value <> ""
        If .Cells(lig, "A").Value = 0 Then
            lig = lig + 1
        Else
            If .Cells(lig, "A").Value = .Cells(lig - 1, "A").Value Then
                lig = lig + 1
            Else
                .Cells(Pos, "B").Value = .Cells(lig, "A").Value
                .Cells(Pos, "C").Value = .Cells(lig, "P").Value
                .Cells(Pos, "D").Value = .Cells(lig, "Q").Value
                Pos = Pos + 1
                lig = lig + 1
            End If
        End If
    Loop
 
    For Each Courbe In .ChartObjects
        Courbe.Delete
    Next Courbe
 
    Application.Calculation = xlAutomatic
    Set Plage = .Range(.Cells(61, 2), .Cells(.Cells(62, 2).End(xlDown).Row, 4))
 
    .Shapes.AddChart2(227, xlLine).Select
 
End With
 
With ActiveChart
    .SetSourceData Plage
    .SetElement (msoElementDataTableWithLegendKeys)
 
    Set Plage = Sheets("CA Jour").Range("B43", "R60")
    With .Parent
        .Left = Plage.Left
        .Width = Plage.Width
        .Top = Plage.Top
        .Height = Plage.Height
    End With
End With
 
Sheets("CA Jour").Range("A1").Select
 
End Sub

**ludo01** · 18/05/2015, 22h47

Bonsoir,

Merci pour ta réactivité.

Lorsque je remplace mon code par le tiens, j'ai un message d'erreur "438" sur cette ligne:

Code :

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

    .Shapes.AddChart2(227, xlLine).Select

Je ne sais pas quelle modification je dois faire.

Peux tu m'aider?

Merci encore.

**joe.levrai** · 18/05/2015, 23h44

ça fonctionnait bien quand j'ai testé, mais là aussi j'ai une erreur

j'ai modifié nettoyé le superflu qui posait problème
j'en ai profité pour retoucher un peu le reste, il y a aussi une sécurité qui annule le programme s'il n'y a pas au moins deux lignes remplies

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
Sub Graph()
Dim Plage As Range
Dim Courbe As ChartObject
Dim Lig As Long, LigFin As Long, Pos As Long
 
With ThisWorkbook.Worksheets("CA Jour")
    Pos = 62
    Lig = 11
 
    .Range(.Cells(Pos, 2), .Cells(Pos + 30, 2)).ClearContents
    LigFin = .Cells(Lig, 1).End(xlDown).Row
    Application.Calculation = xlManual
 
    For i = Lig To LigFin
        If .Cells(i, 1) <> "" _
        And .Cells(i, 1) <> .Cells(i - 1, 1) Then
 
            .Cells(Pos, 2) = .Cells(i, 1)
            .Cells(Pos, 3) = .Cells(i, 16)
            .Cells(Pos, 4) = .Cells(i, 17)
            Pos = Pos + 1
        End If
    Next i
 
    Application.Calculation = xlAutomatic
    Set Plage = .Range(.Cells(61, 2), .Cells(.Cells(62, 2).End(xlDown).Row, 4))
 
    ' si il y a moins de 2 objectifs dans la plage
    If Plage Is Nothing Then Exit Sub
    If Plage.Cells.Count < 8 Then Exit Sub
 
    For Each Courbe In .ChartObjects
        Courbe.Delete
    Next Courbe
 
    .Shapes.AddChart(xlLine).Select
End With
 
With ActiveChart
    .SetSourceData Plage
    .SetElement (msoElementDataTableWithLegendKeys)
 
    Set Plage = Sheets("CA Jour").Range("B43", "R60")
    With .Parent
        .Left = Plage.Left
        .Width = Plage.Width
        .Top = Plage.Top
        .Height = Plage.Height
    End With
End With
 
Sheets("CA Jour").Range("A1").Select
 
End Sub

**ludo01** · 19/05/2015, 22h53

Bonsoir et merci,

Ton code fonctionne très bien mais malgré de nombreuses tentatives, je n'arrive pas à l'adapter à mon fichier définitif.

Je suis dépassé: 2 feuilles, 5 graphiques....

Trop pour moi

Si je peux encore abuser de ton temps, je suis preneur.

Merci encore

**joe.levrai** · 20/05/2015, 02h05

Bonjour,

j'ai testé le code ci-dessous sur ton fichier, et ça m'a l'air bon
j'ai ajouté également le titre automatique, et le positionnement particulier des graphiques (total puis A puis B etc...)

tu pourras très facilement, si besoin, ajouter des nouvelles feuilles, elles sont stockées en début de code dans un tableau

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
Sub Graph()
Dim Plage As Range
Dim Courbe As ChartObject
Dim Lig As Long, LigFin As Long, Pos As Long
Dim ListeFeuille() As Variant
Dim Sh As Worksheet
 
Application.ScreenUpdating = False
ListeFeuille = Array("CA Jour", "HEC Jour")
 
For j = LBound(ListeFeuille) To UBound(ListeFeuille)
    Set Sh = ThisWorkbook.Worksheets(ListeFeuille(j))
    Sh.Activate
    For Each Courbe In Sh.ChartObjects
        Courbe.Delete
    Next Courbe
 
    ' pour les 6 zones du tableau (de A à TOTAL)
    For k = 0 To 5
        ' exclusion de E
        If k <> 4 Then
            With Sh
                Pos = 62 'ligne de départ de la zone source du graphique
 
                'efface la zone de source du graphique
                .Range(.Cells(Pos - 1, 2 + (3 * k)), .Cells(Pos + 30, 4 + (3 * k))).ClearContents
 
                'titre des axes
                .Cells(Pos - 1, 3 + (3 * k)).Value = "Objectif"
                .Cells(Pos - 1, 4 + (3 * k)).Value = "Réalisé"
                Application.Calculation = xlManual
 
                Lig = 11 'ligne de départ des données du tableau
                LigFin = .Cells(Lig, 1).End(xlDown).Row ' et la ligne de fin
 
                For i = Lig To LigFin
                    ' si il y a un numéro de jour
                    ' et qu'il est différent du précédent
                    ' (= on est pas sur un weekend ou jour férié)
                    If .Cells(i, 1) <> "" _
                    And .Cells(i, 1) <> .Cells(i - 1, 1) Then
 
                        ' écriture des données pour la source du graphique
                        .Cells(Pos, 2 + (3 * k)) = .Cells(i, 1)
                        .Cells(Pos, 3 + (3 * k)) = .Cells(i, 4 + (3 * k))
                        .Cells(Pos, 4 + (3 * k)) = .Cells(i, 5 + (3 * k))
 
                        ' on remplace les erreurs par des 0
                        If .Cells(i, 4 + (3 * k)) = "#REF!" Then .Cells(i, 4 + (3 * k)) = 0
                        If .Cells(i, 4 + (3 * k)) = "#REF!" Then .Cells(i, 5 + (3 * k)) = 0
                        Pos = Pos + 1
                    End If
                Next i
 
                Application.Calculation = xlAutomatic
                ' la source du graphique
                Set Plage = .Range(.Cells(61, 2 + (3 * k)), .Cells(.Cells(62, 2).End(xlDown).Row, 4 + (3 * k)))
                .Shapes.AddChart(xlLine).Select
            End With
 
            With ActiveChart
                .SetSourceData Plage
                .SetElement (msoElementDataTableWithLegendKeys)
                .SetElement (msoElementChartTitleAboveChart)
 
                ' le titre du graphique
                .ChartTitle.Caption = Sh.Cells(5, 4 + (3 * k)).Value
 
                ' le positionnement des graphiques
                ' avec gestion de l'agencement (total, puis A, puis B, puis C, puis D)
                Set Plage = Sh.Range(Sh.Cells(43 + (18 * ((k + 1) Mod 6)), 2), Sh.Cells(60 + (18 * ((k + 1) Mod 6)), 18))
                With .Parent
                    .Left = Plage.Left
                    .Width = Plage.Width
                    .Top = Plage.Top
                    .Height = Plage.Height
                End With
            End With
        End If
    Next k
    Set Sh = Nothing
Next j
Application.ScreenUpdating = True
MsgBox "Terminé"
End Sub

MAJ Graphique grâce à une macro [XL-2010]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager