Placer et dimensionner un graphique Excel en fonction de son nom

Bonjour , j'aimerais dimensionner un seul graphique et non plusieurs. Aujourd'hui ma macro fonctionne parfaitement lorsque j'ai un seul graphique sur la feuille. Dès que j'ajoute un autre graphique, ça me place le mauvais graphique.

Voici mon code :

Sub creationgraphsem2()
Range("H42:Q87").Select
Selection.Delete Shift:=xlToLeft

'Semestre 1'
Range("T16:V16").Select
ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
Application.CutCopyMode = False
ActiveChart.FullSeriesCollection(1).Delete
ActiveChart.SeriesCollection.NewSeries
ActiveChart.FullSeriesCollection(1).Name = "=val!$T$16"
ActiveChart.FullSeriesCollection(1).Values = "=val!$U$18:$V$18"
ActiveChart.SeriesCollection.NewSeries
ActiveChart.FullSeriesCollection(2).Name = "=val!$T$23"
ActiveChart.FullSeriesCollection(2).Values = "=val!$U$25:$V$25"
ActiveChart.SeriesCollection.NewSeries
ActiveChart.FullSeriesCollection(3).Name = "=val!$T$30"
ActiveChart.FullSeriesCollection(3).Values = "=val!$U$32:$V$32"
ActiveChart.FullSeriesCollection(3).XValues = "=val!$U$16:$V$16"
ActiveChart.HasLegend = True
ActiveChart.HasTitle = True
ActiveChart.ChartTitle.Text = "Fiabilité & Disponibilité des machines - Janvier/Février/Mars"
ActiveChart.Parent.Name = "Graphique1"
ActiveChart.FullSeriesCollection(1).Select
ActiveChart.FullSeriesCollection(1).ApplyDataLabels
ActiveChart.FullSeriesCollection(2).Select
ActiveChart.FullSeriesCollection(2).ApplyDataLabels
ActiveChart.FullSeriesCollection(3).Select
ActiveChart.FullSeriesCollection(3).ApplyDataLabels
ActiveChart.Axes(xlValue).MinimumScale = 0
ActiveChart.Axes(xlValue).MaximumScale = 1
Application.CommandBars("Format Object").Visible = False
ActiveChart.ChartArea.Select
Call redimensionnergraphique



End Sub
Sub redimensionnergraphique()
Dim xRg As Range
Dim xChart As ChartObject
Set xRg = Range("I48:Q74")
Set xChart = ActiveSheet.ChartObjects(1)
With xChart
.Top = xRg(1).Top
.Left = xRg(1).Left
.Width = xRg.Width
.Height = xRg.Height
End With

End Sub

Bonjour,

Il faut que vos graphes portent des noms distincts et rendre votre procédure paramétrique :

Sub Testredimensionnergraphique()

    redimensionnergraphique "Graphique1"
    redimensionnergraphique "Graphique2"

End Sub

Sub redimensionnergraphique(ByVal NomDuGraphique As String)

Dim xRg As Range
Dim xChart As ChartObject

    Set xChart = ActiveSheet.ChartObjects(NomDuGraphique)
    Select Case NomDuGraphique
           Case "Graphique1"
                Set xRg = Range("I48:Q74")
           Case "Graphique2"
                Set xRg = Range("I80:Q106")
    End Select

    With xChart
        .Top = xRg(1).Top
        .Left = xRg(1).Left
        .Width = xRg.Width
        .Height = xRg.Height
    End With

    Set xChart = Nothing

End Sub

D'accord Merci,

Il ne doit redimensionner qu'un seule graphique(les autres seront déjà sur la feuille), j'ai donc fait ceci :

Sub creationgraphsem2()

'Semestre 1'
Range("T16:V16").Select
ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
Application.CutCopyMode = False
ActiveChart.FullSeriesCollection(1).Delete
ActiveChart.SeriesCollection.NewSeries
ActiveChart.FullSeriesCollection(1).Name = "=val!$T$16"
ActiveChart.FullSeriesCollection(1).Values = "=val!$U$18:$V$18"
ActiveChart.SeriesCollection.NewSeries
ActiveChart.FullSeriesCollection(2).Name = "=val!$T$23"
ActiveChart.FullSeriesCollection(2).Values = "=val!$U$25:$V$25"
ActiveChart.SeriesCollection.NewSeries
ActiveChart.FullSeriesCollection(3).Name = "=val!$T$30"
ActiveChart.FullSeriesCollection(3).Values = "=val!$U$32:$V$32"
ActiveChart.FullSeriesCollection(3).XValues = "=val!$U$16:$V$16"
ActiveChart.HasLegend = True
ActiveChart.HasTitle = True
ActiveChart.ChartTitle.Text = "Fiabilité & Disponibilité des machines - Janvier/Février/Mars"
ActiveChart.Parent.Name = "Graphique1"
ActiveChart.FullSeriesCollection(1).Select
ActiveChart.FullSeriesCollection(1).ApplyDataLabels
ActiveChart.FullSeriesCollection(2).Select
ActiveChart.FullSeriesCollection(2).ApplyDataLabels
ActiveChart.FullSeriesCollection(3).Select
ActiveChart.FullSeriesCollection(3).ApplyDataLabels
ActiveChart.Axes(xlValue).MinimumScale = 0
ActiveChart.Axes(xlValue).MaximumScale = 1
Application.CommandBars("Format Object").Visible = False
Call redimensionnergraphique("Graphique 1")

End Sub

Sub redimensionnergraphique(ByVal NomDuGraphique As String)
Dim xRg As Range
Dim xChart As ChartObject

Set xChart = ActiveSheet.ChartObjects(NomDuGraphique)
Select Case NomDuGraphique
Case "Graphique1"
Set xRg = Range("I48:Q74")

End Select

With xChart
.Top = xRg(1).Top
.Left = xRg(1).Left
.Width = xRg.Width
.Height = xRg.Height
End With

Set xChart = Nothing

End Sub

Mais une erreur s'affiche : L'élement portant ce nom est introuvable

Merci

Le nom du graphique dans redimensionnergraphique n'a pas la même syntaxe.

Oui j'ai donc ajouté ça pour avoir le bon nom : a = ActiveChart.Name
Call redimensionnergraphique(a)

et dans la deuxième fonction j'ai ajouté dans le Cas le bon nom

Le mieux serait de mettre en ligne un fichier exemple sans données confidentielles.

Oui pas de soucis!

Merci

Voici

Je ne sais pas si j'ai bien tout compris. Le code dans le fichier joint supprime le graphe appelé "Sites Graphique4", le regénère et le déplace à l'endroit souhaité.

J'ai supprimé les autres graphes pour l'exemple.