VBA définir le nom du graphique lors de l'ajout

L

ludoxa

XLDnaute Nouveau
Bonjour à tous,

j'exécute plusieurs macros d'ajout de graph sur un classeur. A chaque fois le nom du graphique s'incrémente "Graphique 1", "Graphique 2", etc... et j'utilise ce nom pour renommer et placer mon graph, voici le code :
' MISE EN FORME renommer le graphique pour pouvoir le placer
ActiveSheet.Shapes("Graphique 19").Name = "PMDVID"
With ActiveSheet.Shapes("PMDVID")
.Left = Range("B370").Left
.Top = Range("B370").Top
End With​
Du coup, si je n'exécute pas les macros dans l'ordre, ça ne marche pas.
Ma question c'est : est-il possible de définir ce nom en amont au moment de l'ajout dans la page afin que le nom de base soit toujours le même ? (j'ai fait une chose comme ça pour ajouter des nouvelles feuilles dans mon classeur avec toujours le même nom mais je n'ai pas réussi à le reproduire pour les graphs...)
Ou bien de désactiver l'incrémentation ???

Merci de votre aide

Ludoxa
 
Trier par date Trier par votes
mromain

mromain

XLDnaute Barbatruc
Re : VBA définir le nom du graphique lors de l'ajout

bonjour ludoxa,

si tu n'a qu'un seul graphique dont le nom commence par "Graphique", tu peux essayer de le renommer avec cette macro
Code: 
For Each laShape In ActiveSheet.Shapes
    If laShape.Name Like "Graphique*" Then laShape.Name = "PMDVID"
Next laShape

sinon, il faudrait modifier tes macro de "création de graphique" pour le renommer dès leur création.

a+
 
Vote positif 0 Vote négatif
L

ludoxa

XLDnaute Nouveau
Re : VBA définir le nom du graphique lors de l'ajout

mromain à dit:
bonjour ludoxa,

si tu n'a qu'un seul graphique dont le nom commence par "Graphique", tu peux essayer de le renommer avec cette macro
Code: 
For Each laShape In ActiveSheet.Shapes
    If laShape.Name Like "Graphique*" Then laShape.Name = "PMDVID"
Next laShape

sinon, il faudrait modifier tes macro de "création de graphique" pour le renommer dès leur création.

a+
Cliquez pour agrandir...

tu définis laShape as string ?
 
Vote positif 0 Vote négatif
L

ludoxa

XLDnaute Nouveau
Re : VBA définir le nom du graphique lors de l'ajout

Voici mon code en entier, merci d'avance.

Dim feuille As Worksheet
Dim plage As Range
' DECLARATION tableau avec tous les noms des feuilles
Set feuilles = Sheets(Array("AIGUEPERSE", "ALBIGNY-SUR-SAONE", "ALIX", "AMPLEPUIS", "AMPUIS", "ANSE", "ARNAS", "AVEIZE", "AVENAS", "BAGNOLS", "BEAUJEU", "BELLEVILLE", "BESSENAY", "BLACÉ", "BOURG DE THIZY", "BRIGNAIS", "BRINDAS", "BRULLIOLES", "BRUSSIEU", "BULLY", "CAILLOUX-SUR-FONTAINES", "CHAMBOST-LONGESSAIGNE", "CHAMELET", "CHAMPAGNE-AU-MONT-D'OR", "CHAPONNAY", "CHAPONOST", "CHARBONNIERES-LES-BAINS", "CHARENTAY", "CHARLY", "CHARNAY", "CHASSAGNY", "CHASSELAY", "CHASSIEU", "CHATILLON D'AZERGUES - CHESSY", "CHAUSSAN", "CHAZAY D'AZERGUES", "CHEVINAY", "CHIROUBLES", "CLAVEISOLLES", "COGNY", "COISE", "COLLONGES-AU-MONT-D'OR", "COLOMBIER-SAUGNIEU", "COMMUNAY", "CONDRIEU", "CORBAS", "CORCELLES-EN-BEAUJOLAIS", "COURS-LA-VILLE", "COURZIEU", "COUZON-AU-MONT-D'OR", "CRAPONNE", "CUBLIZE", "CURIS-AU-MONT-D'OR", "DARDILLY", "DENICÉ", "DOMMARTIN", "DUERNE", "ECHALAS", "EVEUX", "FEYZIN", "FLEURIE", "FLEURIEU-SUR-SAONE", "FLEURIEUX-SUR-L'ARBRESLE", "FONTAINES-SUR-SAONE", "FRANCHEVILLE"))

For Each feuille In feuilles
' DECLARATION plage des données source
Set plage = feuille.Range("AO1:AO8")
Charts.Add
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=plage, PlotBy _
:=xlColumns
ActiveChart.SeriesCollection(1).XValues = feuille.Range("A2:A8")
ActiveChart.SeriesCollection(1).Name = feuille.Range("AO1")
' MISE EN FORME localisation du graphique dans la feuille
ActiveChart.Location Where:=xlLocationAsObject, Name:=feuille.Name
' MISE EN FORME titre légende
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Evolution des prêts MD Vidéo"
.Axes(xlCategory, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).HasTitle = False
.HasLegend = False
End With
ActiveChart.HasLegend = False
ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowValue, LegendKey:=False
' MISE EN FORME changement de couleur
ActiveChart.SeriesCollection(1).Points(1).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With Selection.Interior
' vert relais
.ColorIndex = 43
.Pattern = xlSolid
End With
ActiveChart.SeriesCollection(1).Points(2).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With Selection.Interior
' vert relais
.ColorIndex = 43
.Pattern = xlSolid
End With
ActiveChart.SeriesCollection(1).Points(3).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With Selection.Interior
' vert relais
.ColorIndex = 43
.Pattern = xlSolid
End With
ActiveChart.SeriesCollection(1).Points(4).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With Selection.Interior
' vert relais
.ColorIndex = 43
.Pattern = xlSolid
End With
ActiveChart.SeriesCollection(1).Points(5).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With Selection.Interior
' vert relais
.ColorIndex = 43
.Pattern = xlSolid
End With
ActiveChart.SeriesCollection(1).Points(6).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With Selection.Interior
' bleu réseau
.ColorIndex = 41
.Pattern = xlSolid
End With
ActiveChart.SeriesCollection(1).Points(7).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With Selection.Interior
' jaune md
.ColorIndex = 44
.Pattern = xlSolid
End With
' MISE EN FORME renommer le graphique pour pouvoir le placer
ActiveSheet.Shapes("Graphique 19").Name = "PMDVID"
With ActiveSheet.Shapes("PMDVID")
.Left = Range("B370").Left
.Top = Range("B370").Top
End With
' FORMATAGE ne pas déplacer et dimensionner avec les cellules
With ActiveSheet.DrawingObjects("PMDVID")
.Placement = xlFreeFloating
.PrintObject = True
End With
ActiveSheet.DrawingObjects("PMDVID").Locked = True

Next

End Sub
 
Vote positif 0 Vote négatif
mromain

mromain

XLDnaute Barbatruc
Re : VBA définir le nom du graphique lors de l'ajout

re,

essaye de le mettre ici :
Code: 
Dim feuille As Worksheet
Dim plage As Range
' DECLARATION tableau avec tous les noms des feuilles
Set feuilles = Sheets(Array("AIGUEPERSE", "ALBIGNY-SUR-SAONE", "ALIX", "AMPLEPUIS", "AMPUIS", "ANSE", "ARNAS", "AVEIZE", "AVENAS", "BAGNOLS", "BEAUJEU", "BELLEVILLE", "BESSENAY", "BLACÉ", "BOURG DE THIZY", "BRIGNAIS", "BRINDAS", "BRULLIOLES", "BRUSSIEU", "BULLY", "CAILLOUX-SUR-FONTAINES", "CHAMBOST-LONGESSAIGNE", "CHAMELET", "CHAMPAGNE-AU-MONT-D'OR", "CHAPONNAY", "CHAPONOST", "CHARBONNIERES-LES-BAINS", "CHARENTAY", "CHARLY", "CHARNAY", "CHASSAGNY", "CHASSELAY", "CHASSIEU", "CHATILLON D'AZERGUES - CHESSY", "CHAUSSAN", "CHAZAY D'AZERGUES", "CHEVINAY", "CHIROUBLES", "CLAVEISOLLES", "COGNY", "COISE", "COLLONGES-AU-MONT-D'OR", "COLOMBIER-SAUGNIEU", "COMMUNAY", "CONDRIEU", "CORBAS", "CORCELLES-EN-BEAUJOLAIS", "COURS-LA-VILLE", "COURZIEU", "COUZON-AU-MONT-D'OR", "CRAPONNE", "CUBLIZE", "CURIS-AU-MONT-D'OR", "DARDILLY", "DENICÉ", "DOMMARTIN", "DUERNE", "ECHALAS", "EVEUX", "FEYZIN", "FLEURIE", "FLEURIEU-SUR-SAONE", "FLEURIEUX-SUR-L'ARBRESLE", "FONTAINES-SUR-SAONE", "FRANCHEVILLE"))

For Each feuille In feuilles
    ' DECLARATION plage des données source
    Set plage = feuille.Range("AO1:AO8")
    Charts.Add
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.SetSourceData Source:=plage, PlotBy _
    :=xlColumns
    ActiveChart.SeriesCollection(1).XValues = feuille.Range("A2:A8")
    ActiveChart.SeriesCollection(1).Name = feuille.Range("AO1")
    ' MISE EN FORME localisation du graphique dans la feuille
    ActiveChart.Location Where:=xlLocationAsObject, Name:=feuille.Name
    ' MISE EN FORME titre légende
    With ActiveChart
        [COLOR=Red][B].Name = "leNom"[/B][/COLOR]
        .HasTitle = True
        .ChartTitle.Characters.Text = "Evolution des prêts MD Vidéo"
        .Axes(xlCategory, xlPrimary).HasTitle = False
        .Axes(xlValue, xlPrimary).HasTitle = False
        .HasLegend = False
    End With
    ActiveChart.HasLegend = False
    ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowValue, LegendKey:=False
    ' MISE EN FORME changement de couleur
    ActiveChart.SeriesCollection(1).Points(1).Select
    With Selection.Border
        .Weight = xlThin
        .LineStyle = xlAutomatic
    End With
    Selection.Shadow = False
    Selection.InvertIfNegative = False
    With Selection.Interior
        ' vert relais
        .ColorIndex = 43
        .Pattern = xlSolid
    End With
    ActiveChart.SeriesCollection(1).Points(2).Select
    With Selection.Border
        .Weight = xlThin
        .LineStyle = xlAutomatic
    End With
    Selection.Shadow = False
    Selection.InvertIfNegative = False
    With Selection.Interior
        ' vert relais
        .ColorIndex = 43
        .Pattern = xlSolid
    End With
    ActiveChart.SeriesCollection(1).Points(3).Select
    With Selection.Border
        .Weight = xlThin
        .LineStyle = xlAutomatic
    End With
    Selection.Shadow = False
    Selection.InvertIfNegative = False
    With Selection.Interior
        ' vert relais
        .ColorIndex = 43
        .Pattern = xlSolid
    End With
    ActiveChart.SeriesCollection(1).Points(4).Select
    With Selection.Border
        .Weight = xlThin
        .LineStyle = xlAutomatic
    End With
    Selection.Shadow = False
    Selection.InvertIfNegative = False
    With Selection.Interior
        ' vert relais
        .ColorIndex = 43
        .Pattern = xlSolid
    End With
    ActiveChart.SeriesCollection(1).Points(5).Select
    With Selection.Border
        .Weight = xlThin
        .LineStyle = xlAutomatic
    End With
    Selection.Shadow = False
    Selection.InvertIfNegative = False
    With Selection.Interior
        ' vert relais
        .ColorIndex = 43
        .Pattern = xlSolid
    End With
    ActiveChart.SeriesCollection(1).Points(6).Select
    With Selection.Border
        .Weight = xlThin
        .LineStyle = xlAutomatic
    End With
    Selection.Shadow = False
    Selection.InvertIfNegative = False
    With Selection.Interior
        ' bleu réseau
        .ColorIndex = 41
        .Pattern = xlSolid
    End With
    ActiveChart.SeriesCollection(1).Points(7).Select
    With Selection.Border
        .Weight = xlThin
        .LineStyle = xlAutomatic
    End With
    Selection.Shadow = False
    Selection.InvertIfNegative = False
    With Selection.Interior
        ' jaune md
        .ColorIndex = 44
        .Pattern = xlSolid
    End With
    ' MISE EN FORME renommer le graphique pour pouvoir le placer
    ActiveSheet.Shapes("Graphique 19").Name = "PMDVID"
    With ActiveSheet.Shapes("PMDVID")
        .Left = Range("B370").Left
        .Top = Range("B370").Top
    End With
    ' FORMATAGE ne pas déplacer et dimensionner avec les cellules
    With ActiveSheet.DrawingObjects("PMDVID")
        .Placement = xlFreeFloating
        .PrintObject = True
    End With
    ActiveSheet.DrawingObjects("PMDVID").Locked = True

Next

a+
 
Vote positif 0 Vote négatif
L

ludoxa

XLDnaute Nouveau
Re : VBA définir le nom du graphique lors de l'ajout

Ca ne marche pas, il me dit :
Erreur d'exécution 1004
La méthode Name de l'objet _Chart a échoué

J'ai aussi essayé avec lashape as shape, là ça ne plante pas mais ça ne fait rien...

Tu as une autre idée ?
 
Vote positif 0 Vote négatif
Pierrot93

Pierrot93

XLDnaute Barbatruc
Re : VBA définir le nom du graphique lors de l'ajout

Re Ludoxa, Romain

un exemple ci dessous de création de graphique incorporé par vba, sans utilisation de nom mais en utilisant une variable "ChartObject", si cela peut te servir... :

Code: 
Option Explicit
Sub CreationGraphique()
Dim c As ChartObject
Set c = Feuil1.ChartObjects.Add(Range("G15").Left, Range("G15").Top, 300, 200)
With c.Chart
    .ChartType = xlLineMarkers
    .SeriesCollection.Add Range("C1:C17"), , True
    .SeriesCollection(1).XValues = Range("A2:A17")
    With .Legend
        .Position = xlBottom
        With .Font
            .Size = 8
            .Bold = True
        End With
    End With
    With .ChartTitle
        .Text = "mongraph"
        With .Font
            .Size = 8
            .Bold = True
        End With
    End With
    With .Axes(xlCategory).TickLabels
        .Font.Size = 8
        .NumberFormat = "dd/mm/yy"
        .Orientation = 45
    End With
    .Axes(xlValue).TickLabels.Font.Size = 8
End With
End Sub

bonne fin d'après midi
@+
 
Vote positif 0 Vote négatif

Discussions similaires

Fredox
  • Question
XL 2019 [VBA] Modifier la position de l'image contenue dans la cellule active
2
Réponses
16
Affichages
3 K
Fredox
Fredox
O
  • Question
XL 2019 Excel VBA - Condition selon le nom du fichier
Réponses
5
Affichages
2 K
Staple1600
Staple1600
Fredox
  • Question
XL 2016 [Résolu] - [VBA] Récupérer le nom de la feuille 1 d'un fichier externe ouvert dans la procédure
Réponses
5
Affichages
2 K
Fredox
Fredox
L
  • Question
XL 2013 positionnement de plusieurs graphique dans une plage de données sur des lignes différente
Réponses
9
Affichages
1 K
Lionel7918e
L
R
  • Question
XL 2016 Gestion de chemin de fichiers + VBA
Réponses
0
Affichages
3 K
Ryoken
R
C
  • Question
Microsoft 365 GRAPHIQUE VBA - COMMENT INDIQUER UNE VALEUR A ZERO SUR LE GRAPHIQUE
Réponses
5
Affichages
1 K
Charles78
C
bellenm
  • Question
Besoin du code pour image inkPicture qui irait se sauver dans le dossier "Temp" et doit être nomé visite4
Réponses
0
Affichages
324
bellenm
bellenm
O
  • Question
Utilisation de * dans du VBA
Réponses
10
Affichages
1 K
obelix77
O
F
  • Question
VBA Récupérer le nom du format de contrôle
2
Réponses
15
Affichages
3 K
FAB80170
F
D
  • Question
XL 2016 Trier une liste en fonction de plusieurs critères en VBA? (et pas en mode enregistrement macro)
Réponses
1
Affichages
1 K
doublenico
D

Membres actuellement en ligne

3 membres et 57 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 196
Messages
2 086 101
Membres
103 116
dernier inscrit
kutobi87