XL 2010 VBA - Générer plusieurs graphiques avec des données sources disjointes.

kaisermpt

XLDnaute Junior
Bonjour à tous, 


Je me permets de vous solliciter pour la création d'une macro. 

En effet, dans le cadre de la réalisation de rapports, je dois pouvoir réaliser des graphiques individualisés. 

Je souhaite donc disposer d'une macro permettant de générer automatiquement l'intégralité de ces graphiques. 

Les données de ces graphiques se situent dans des colonnes qui sont dispersées dans mon fichier excel.  

Je vous transmets un fichier pour exemple (je dois ainsi réaliser un graphique par ville et avec les données en jaune dans le fichier puis un autre graphique avec les données en rouge). 

Je précise que chacun des graphiques devra ensuite renommé afin d'être intégrer dans un rapport WORD.

En vous remerciant d'avance pour votre aide 

Sébastien  
 

Fichiers joints

vgendron

XLDnaute Barbatruc
Hello
un début de réponse avec ce code
VB:
Sub Macro1()
Application.ScreenUpdating = False
'
' Macro1 Macro
'

    'Nb de villes
    NbVilles = Range("A" & Rows.Count).End(xlUp).Row - 2
   
    'masquer les colonnes inutiles
    Range("C:E,G:I,K:M,O:Q,S:U,W:Y,AA:AC,AE:AG").EntireColumn.Hidden = True
   
    For i = 1 To NbVilles
        Set ZoneData = Range("$A$2:$N$2,$A" & i + 2 & ":$N" & i + 2)
        'ZoneData.Select
       'Range ("'Feuil1'!$A$2:$N$2;'Feuil1'!$A$4:$N$4")
        'insère un graphique
        ActiveSheet.Shapes.AddChart.Select
   
        'set la zone de données
        ActiveChart.SetSourceData Source:=ZoneData
   
    'définit le type de graphique
    ActiveChart.ChartType = xlXYScatterLines
   
    'lui donne le nom de la Ville
    ActiveChart.Parent.Name = Range("A" & i + 2)
   
    Next i
Application.ScreenUpdating = True
   
End Sub
Les graphiques sont créés les uns au dessus des autres
et uniquement pour les données en colonnes B F J et N
 

vgendron

XLDnaute Barbatruc
Avec un déplacement des graphs les uns en dessous des autres (au chevauchement près)
VB:
Sub Macro1()
Application.ScreenUpdating = False

    'Nb de villes
    NbVilles = Range("A" & Rows.Count).End(xlUp).Row - 2
   
    'masquer les colonnes inutiles
    Range("C:E,G:I,K:M,O:Q,S:U,W:Y,AA:AC,AE:AG").EntireColumn.Hidden = True
   
    For i = 1 To NbVilles
        Set ZoneData = Range("$A$2:$N$2,$A" & i + 2 & ":$N" & i + 2)
   
        'insère un graphique
        ActiveSheet.Shapes.AddChart.Select
       
   
        'set la zone de données
        ActiveChart.SetSourceData Source:=ZoneData
        'on déplace le graphique sur la feuille
        ActiveSheet.ChartObjects(i).Left = Range("A" & i * 11).Left
        ActiveSheet.ChartObjects(i).Top = Range("A" & i * 11).Top

   
    'définit le type de graphique
    ActiveChart.ChartType = xlXYScatterLines
   
    'lui donne le nom de la Ville
    ActiveChart.Parent.Name = Range("A" & i + 2)
   
    Next i
Application.ScreenUpdating = True
   
End Sub
 

kaisermpt

XLDnaute Junior
Bonjour

Merci pour ta réponse. Je regarde ça et je reviens vers toi si j'ai d'autres compléments d'information.

Sébastien
 

vgendron

XLDnaute Barbatruc
Je viens de voir que si tu démasquais les colonnes.. alors, celles ci se retrouvent prises en compte dans les graphes...
donc. je pense qu'il faut exporter les données utiles dans une autre feuille..
VB:
Sub Macro1()
Application.ScreenUpdating = False

With Sheets("Feuil1")
    'masquer les colonnes inutiles
    .Range("C:E,G:I,K:M,O:Q,S:U,W:Y,AA:AC,AE:AG").EntireColumn.Hidden = True
    .Range("B3").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("Feuil2").Range("A2")
   
End With

With Sheets("Feuil2")
    .Activate
    'Nb de villes
    NbVilles = .Range("A" & .Rows.Count).End(xlUp).Row - 2
    For i = 1 To NbVilles
        Set ZoneData = .Range("$A$2:$E$2,$A" & i + 2 & ":$E" & i + 2)
   
        'insère un graphique
        .Shapes.AddChart.Select
       
   
        'set la zone de données
        ActiveChart.SetSourceData Source:=ZoneData
        'on déplace le graphique sur la feuille
        .ChartObjects(i).Left = .Range("A" & i * 11).Left
        .ChartObjects(i).Top = .Range("A" & i * 11).Top

   
    'définit le type de graphique
    ActiveChart.ChartType = xlXYScatterLines
   
    'lui donne le nom de la Ville
    ActiveChart.Parent.Name = .Range("A" & i + 2)
   
    Next i
End With
Application.ScreenUpdating = True
   
End Sub
 

KIM

XLDnaute Accro
Bonjour vgendron,
Bonjour le fil, bonjour le forum,
Cette discussion est intéressante. Par contre je cherche une méthode de générer un seul graphique en vba. Est-il possible de regrouper ces graphiques dans un seul graphique avec des couleurs différentes pour chaque ville ? Cela permet de comparer les villes dans un seul graphique.
 

vgendron

XLDnaute Barbatruc
Hello Kim
Il vaudrait mieux que tu crées ton propre post pour avoir une réponse directement adaptée à ton besoin..
sinon..
VB:
Sub Macro1()
Application.ScreenUpdating = False

With Sheets("Feuil1")
    .Activate
    'Nb de villes
    NbVilles = .Range("A" & .Rows.Count).End(xlUp).Row - 2
           
    'on set la zone qui contient les données à tracer -->ici sur 4 colonnes
    Set ZoneData = .Range("$A$2").Resize(NbVilles + 1, 5)
       
   
        'insère un graphique
        .Shapes.AddChart.Select
       
   
        'set la zone de données
        ActiveChart.SetSourceData Source:=ZoneData, PlotBy:=xlRows
       
   
    'définit le type de graphique
    ActiveChart.ChartType = xlXYScatterLines
   
    'lui donne le nom de la Ville
    ActiveChart.Parent.Name = "NOM Graphique"
   
    'Next i
End With
Application.ScreenUpdating = True
   
End Sub
 

Discussions similaires


Haut Bas