Positionner un graphique avec VBA

Version imprimable

Bonjour
j'ai fait une macro qui permet d'afficher un graphique mais j'aimerai bien lui affecter une position bien précise sur ma feuille excel, voici mon code:
Merci pour votre aide

Code:

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
Sub KPI1()
'macro pour l histogramme
Dim sh As Worksheet
Dim chrt As Chart
Dim chrto As ChartObject
Dim sc As SeriesCollection
Dim ser As Series
 
 
        Set sh = Sheets("Indicateur")
        With sh
 
 
 
             For Each chrto In .ChartObjects
 
                  chrto.Delete               'Supprimer l'ancien histogramme
             Next chrto
 
             Set chrt = .Shapes.AddChart.Chart
             With chrt
                 Set sc = .SeriesCollection       'Définir les series avec les quelles on va travailler
                 Set ser = sc.NewSeries
 
                 With ser
                      .Name = Range("A1").Offset(7, 0).Value
                      .XValues = Range(sh.Range("A1").Offset(0, 1), sh.Range("A1").End(xlToRight))
                      .Values = Range(sh.Range("A8").Offset(0, 1), sh.Range("A8").End(xlToRight))
                      .ChartType = xlColumnClustered             'Type du graphique qui est histogramme
                 End With
            End With
 
            Set chrt = Nothing
        End With
        Set sh = Nothing
End Sub

04/09/2017, 15h00
Invité

Citation:

Envoyé par mxitzny

Bonjour,

A tester.

Si votre onglet ne contient qu'un seul histogramme, vous pourriez modifier les propriétés Top et Left de votre objet Chrto après la construction du graphe avec le même genre de boucle qui vous sert à détruire.

Bonjour
Je compte mettre de graphique dans le même onglet, voici la macro du deuxième graphe

Code:

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
Sub KPI2()
'macro pour le graph ligne
Dim sh As Worksheet
Dim chrt As Chart
Dim chrto As ChartObject
Dim ser As Series
Dim ser1 As Series
Dim ser2 As Series
 
        Set sh = Sheets("Indicateur")
        With sh
 
             For Each chrto In .ChartObjects
                  chrto.Delete               'Supprimer l'ancien histogramme
             Next chrto
 
             Set chrt = .Shapes.AddChart.Chart
             With chrt
                 Set sc = .SeriesCollection       'Définir les series avec les quelles on va travailler
                 Set ser = sc.NewSeries
                 Set sc = .SeriesCollection
                 Set ser1 = sc.NewSeries
                 Set sc = .SeriesCollection
                 Set ser2 = sc.NewSeries
                 With ser
                      .Name = Range("A1").Offset(2, 0).Value
                      .XValues = Range(sh.Range("A1").Offset(0, 1), sh.Range("A1").End(xlToRight))
                      .Values = Range(sh.Range("A3").Offset(0, 1), sh.Range("A3").End(xlToRight))
                      .ChartType = xlLine             'Type du graphique qui est histogramme
                 End With
                 With ser1
                      .Name = Range("A1").Offset(4, 0).Value
                      .XValues = Range(sh.Range("A1").Offset(0, 1), sh.Range("A1").End(xlToRight))
                      .Values = Range(sh.Range("A5").Offset(0, 1), sh.Range("A5").End(xlToRight))
                      .ChartType = xlLine             'Type du graphique qui est histogramme
                 End With
                 With ser2
                      .Name = Range("A1").Offset(6, 0).Value
                      .XValues = Range(sh.Range("A1").Offset(0, 1), sh.Range("A1").End(xlToRight))
                      .Values = Range(sh.Range("A7").Offset(0, 1), sh.Range("A7").End(xlToRight))
                      .ChartType = xlLine             'Type du graphique qui est histogramme
                 End With
            End With
 
            Set chrt = Nothing
        End With
        Set sh = Nothing
 
End Sub

Merci pour votre aide

04/09/2017, 15h38
Invité

Citation:

Envoyé par mxitzny

La destruction de vos objets ChartObjet est incohérente dans ce cas.
04/09/2017, 15h42
mxitzny

Est ce que vous avez une solution à me proposer s'il vous plait, une solution qui me permettra d'afficher les deux indicateurs et les positionner correctement sur la feuille excel ?
Merci pour votre aide.
04/09/2017, 15h46
Invité

Citation:

Envoyé par mxitzny

Il vous suffit de créer une variable ChartObjet dans votre code et de la rattacher au graphique avec

Code:

Set MonChartObject = chrt.parent

Vous pourrez ensuite lui attribuer la position souhaitée.
04/09/2017, 15h54
mxitzny

Est ce que vous pouvez me donner plus de détails car je suis encore débutant? merci pour votre temps

Citation:

Envoyé par mxitzny

Code:

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
Sub KPI1(ByVal PositionHaut As Single, ByVal PositionGauche As Single)
'macro pour l histogramme
Dim sh As Worksheet
Dim chrt As Chart
Dim chrto As ChartObject
Dim sc As SeriesCollection
Dim ser As Series
Dim ShapeGraphique As ChartObject
 
        Set sh = Sheets("Indicateur")
        With sh
             For Each chrto In .ChartObjects
                 chrto.Delete               'Supprimer l'ancien histogramme
             Next chrto
 
             Set chrt = .Shapes.AddChart.Chart
 
             With chrt
 
                 Set ShapeGraphique = .Parent
 
                 Set sc = .SeriesCollection       'Définir les series avec les quelles on va travailler
                 Set ser = sc.NewSeries
 
                 With ser
                      .Name = Range("A1").Offset(7, 0).Value
                      .XValues = Range(sh.Range("A1").Offset(0, 1), sh.Range("A1").End(xlToRight))
                      .Values = Range(sh.Range("A8").Offset(0, 1), sh.Range("A8").End(xlToRight))
                      .ChartType = xlColumnClustered             'Type du graphique qui est histogramme
                 End With
            End With
            With ShapeGraphique
              .Top = PositionHaut
              .Left = PositionGauche
            End With
 
            Set ShapeGraphique = Nothing
            Set chrt = Nothing
        End With
        Set sh = Nothing
End Sub

04/09/2017, 18h17
mxitzny

lorsque j'appelle la fonction je fais comment ?

Code:

call KPI1(100,100)

Autre problème SVP quand j’exécute ma macro mon histogramme ne s'affiche pas (Les valeurs) alors que lorsque j’essaie avec un bouton ça marche ?

Citation:

Envoyé par mxitzny
Code:

1 2 3 4 5 Sub TestKPI1() KPI1 100, 100 End Sub

05/09/2017, 10h40
mxitzny

OK merci
Mais pour arriver à afficher mes 2 graphes ensemble KPI1 et KPI2 sur la même feuille je fait comment SVP?
05/09/2017, 10h44
Invité

Citation:

Envoyé par mxitzny

Mais pour arriver à afficher mes 2 graphes ensemble KPI1 et KPI2 sur la même feuille je fait comment SVP?

Il vous faut mettre la suppression des objets ChartObject en dehors de vos routines KPI.
05/09/2017, 11h03
mxitzny

Est ce que c'est possible de m'expliquer un peu plus car je suis vraiment bleu !!!!!
05/09/2017, 11h32
Invité
Citation:

Envoyé par mxitzny

Est ce que c'est possible de m'expliquer un peu plus car je suis vraiment bleu !!!!!

Il vous faut retirer ces lignes
Code:

1 2 3 4 For Each chrto In .ChartObjects chrto.Delete 'Supprimer l'ancien histogramme Next chrto
et les mettre dans une procédure à part avant la création de vos deux histogrammes, sinon vous supprimez chaque fois le 1er histogramme.

Nb : A la rigueur si KPI2 est lancé après KPI1, vous pouvez laisser la suppression dans KPI1 mais la retirer dans KPI2.
05/09/2017, 17h54
mxitzny

Merci pour votre aide