IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Ameliorer code VBA creation graphique


Sujet :

Macros et VBA Excel

  1. #1
    Membre confirmé
    Étudiant
    Inscrit en
    Juin 2010
    Messages
    125
    Détails du profil
    Informations personnelles :
    Âge : 36

    Informations professionnelles :
    Activité : Étudiant
    Secteur : Transports

    Informations forums :
    Inscription : Juin 2010
    Messages : 125
    Par défaut
    Bonjour a tous,

    j'ai besoin de faire une macro pour creer un graphique. J'ai utiliser l'assistant macro d'excel, mais ca me fait un tres gros code (je trouve).
    J'aurai besoin d'aide pour l'ameliorer et l'epurer :
    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
    Sub Makro1()
     
        Charts.Add
        ActiveChart.ChartType = xlLineMarkers
        ActiveChart.SetSourceData Source:=Sheets("Graph").Range("F5")
        ActiveChart.SeriesCollection.NewSeries
        ActiveChart.SeriesCollection.NewSeries
        ActiveChart.SeriesCollection.NewSeries
        ActiveChart.SeriesCollection(1).XValues = _
            "='Graphikgrundlag. techn. Fortsch'!R6C3:R6C28"
        ActiveChart.SeriesCollection(1).Values = _
            "='Graphikgrundlag. techn. Fortsch'!R7C3:R7C22"
        ActiveChart.SeriesCollection(1).Name = "=""IST"""
        ActiveChart.SeriesCollection(2).Values = _
            "='Graphikgrundlag. techn. Fortsch'!R8C3:R8C24"
        ActiveChart.SeriesCollection(2).Name = "=""Soll"""
        ActiveChart.SeriesCollection(3).Values = _
            "='Graphikgrundlag. techn. Fortsch'!R9C3:R9C28"
        ActiveChart.SeriesCollection(3).Name = "=""Anbindung"""
        ActiveChart.Location Where:=xlLocationAsObject, Name:="Graph"
        ActiveChart.Axes(xlValue).MajorGridlines.Select
        ActiveChart.SeriesCollection(1).Select
        ActiveChart.SeriesCollection(1).ChartType = xlColumnClustered
    End Sub
    Par exemple, j'aimerai que les plages de valeurs pour les courbes en ordonnes ne soit pas fixe mais que ca aille chercher les valeurs jusqu'a la premiere case vide.

    Merci d'avance pour votre aide.

    J'ai trouve un bout de code que j'ai essaye d'adapter a mon cas, mais pour le moment cela ne fonctionne pas (erreur de compilation au niveau du with graphik).

    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
    Sub Courbe()
     
    Dim FSGraph As Chart, Graphik As Worksheet, Donnees As Range
    Dim PlageX As Range, PlageY As Range, MaSerie As Series, cmpt As Long
     
    Set Graphik = Worksheets("Graphikgrundlag. techn. Fortsch")
     
    With Graphik
        Set Donnees = .Range(.Cells(6, 3), .Cells(6, 3).End(xlRight)).Resize(9, 0)
    End With
     
    Set FSGraph = ThisWorkbook.Charts.Add
        FSGraph.ChartArea.Clear
        FSGraph.ChartType = xlXYScatter
     
    Set PlageX = Donnees.Rows(1)
     
    For cmpt = 1 To Donnees.Rows.Count - 1
        Set PlageY = PlageX.Offset(cmpt, 0)
        Set MaSerie = FSGraph.SeriesCollection.Newserie
     
        With MaSerie
            .Values = PlageY
            .XValues = PlageX
            .Name = Donnees.Cells(6, 3).Offset(compteur, -1)
        End With
    Next cmpt

  2. #2
    Membre confirmé
    Étudiant
    Inscrit en
    Juin 2010
    Messages
    125
    Détails du profil
    Informations personnelles :
    Âge : 36

    Informations professionnelles :
    Activité : Étudiant
    Secteur : Transports

    Informations forums :
    Inscription : Juin 2010
    Messages : 125
    Par défaut
    Vu que j'arrive pas a resoudre le probleme j'ai un peu simplifie le code, mais j'ai maintenant une erreur au niveau du
    Set MaSerie = FSGraph.SeriesCollection.NewSeries

    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
    Dim FSGraph As Chart, Graphik As Worksheet, Donnees As Range
    Dim PlageX As Range, PlageY As Range, MaSerie As Series, cmpt As Long
     
    Set Graphik = Worksheets("Graphikgrundlag. techn. Fortsch")
     
    With Graphik
        Set Donnees = .Range(.Cells(6, 3), .Cells(9, 10))
    End With
     
    Set FSGraph = ThisWorkbook.Charts.Add
        FSGraph.ChartArea.Clear
        FSGraph.ChartType = xlXYScatter
     
    Set PlageX = Range("C6:J6")
     
    For cmpt = 1 To 3
        Set PlageY = PlageX.Offset(cmpt, 0)
        Set MaSerie = FSGraph.SeriesCollection.NewSeries
     
        With MaSerie
            .Values = PlageY
            .XValues = PlageX
            .Name = Donnees.Cells(6, 3).Offset(compteur, -1)
        End With
    Next cmpt

  3. #3
    Membre émérite
    Profil pro
    Inscrit en
    Avril 2008
    Messages
    633
    Détails du profil
    Informations personnelles :
    Âge : 57
    Localisation : France

    Informations forums :
    Inscription : Avril 2008
    Messages : 633
    Par défaut
    Bonjour

    A force de tatonnements jai trouvé.

    pour ce code il faut que tu mette le nom des séries a gauche de tes valeurs en cellule B7, B8 et B9.

    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
     
    Sub Courbe()
     
    Dim FSGraph As Chart, Graphik As Worksheet, Donnees As Range
    Dim PlageX As Range, PlageY As Range, MaSerie As Series, cmpt As Long
     
    Set Graphik = Worksheets("Graphikgrundlag. techn. Fortsch")
     
    With Graphik
        Set Donnees = .Range(.Cells(6, 3), .Cells(9, .Cells(6, 3).End(xlToRight).Column))
    End With
     
    Set FSGraph = ThisWorkbook.Charts.Add
        FSGraph.ChartArea.Clear
        FSGraph.ChartType = xlXYScatter
     
    Set PlageX = Donnees.Rows(1)
     
    For cmpt = 1 To Donnees.Rows.Count - 1
        Set PlageY = PlageX.Offset(cmpt, 0)
        Set MaSerie = FSGraph.SeriesCollection.NewSeries
     
        With MaSerie
            .Values = PlageY
            .XValues = PlageX
        End With
        FSGraph.SeriesCollection(cmpt).Name = "=""" & Graphik.Range(Donnees.Cells(cmpt + 1, 0).Address).Value & """"
    Next cmpt
    FSGraph.SeriesCollection(1).ChartType = xlColumnClustered
    FSGraph.Location Where:=xlLocationAsObject, Name:="Graph"
    End Sub

  4. #4
    Membre confirmé
    Étudiant
    Inscrit en
    Juin 2010
    Messages
    125
    Détails du profil
    Informations personnelles :
    Âge : 36

    Informations professionnelles :
    Activité : Étudiant
    Secteur : Transports

    Informations forums :
    Inscription : Juin 2010
    Messages : 125
    Par défaut
    Merci pour cette reponse. Malheureusement, il doit y avoir quelques soucis de compatibilite avec ce que je veux faire.

    Il n'y a pas de soucis au niveau de la compilation, nais lorsque le graphe sort, mon axe des abscisses etant une succession de date, elles ne sortent pas correctement et au niveau de valeurs elles sont toutes sur une seule abscisse.

    Je joins mon fichier pour que ce soit plus clair.
    Fichiers attachés Fichiers attachés

  5. #5
    Membre émérite
    Profil pro
    Inscrit en
    Avril 2008
    Messages
    633
    Détails du profil
    Informations personnelles :
    Âge : 57
    Localisation : France

    Informations forums :
    Inscription : Avril 2008
    Messages : 633
    Par défaut
    Bonjour

    j'ai regardé ton fichier et le problème viens des dates, je ne connais pas assez les graphs pour en connaitre la raison mais j'ai trouvé un paliatif en ajoutant 2 boucles, la premiere en début de code pour remplacer les dates en texte et l'autre à la fin pour faire l'inverse.

    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
     
    Sub Courbe()
     
    Dim FSGraph As Chart, Graphik As Worksheet, Donnees As Range
    Dim PlageX As Range, PlageY As Range, MaSerie As Series, cmpt As Long
     
    Set Graphik = Worksheets("Graphikgrundlag. techn. Fortsch")
     
    ' # Boucle pour transformer les date en texte
    For Each PlageX In Graphik.Range(Graphik.Cells(6, 3), Graphik.Cells(6, Graphik.Cells(6, 3).End(xlToRight).Column))
        PlageX = "'" & Format(PlageX.Value, "mmm-yy")
    Next
     
    With Graphik
        Set Donnees = .Range(.Cells(6, 3), .Cells(9, .Cells(6, 3).End(xlToRight).Column))
    End With
     
    Set FSGraph = ThisWorkbook.Charts.Add
        FSGraph.ChartArea.Clear
        FSGraph.ChartType = xlXYScatter
     
    Set PlageX = Donnees.Rows(1)
     
    For cmpt = 1 To Donnees.Rows.Count - 1
        Set PlageY = PlageX.Offset(cmpt, 0)
        Set MaSerie = FSGraph.SeriesCollection.NewSeries
     
        With MaSerie
            .Values = PlageY
            .XValues = PlageX
        End With
        FSGraph.SeriesCollection(cmpt).Name = "=""" & Graphik.Range(Donnees.Cells(cmpt + 1, 0).Address).Value & """"
    Next cmpt
    FSGraph.SeriesCollection(1).ChartType = xlColumnClustered
    FSGraph.Location Where:=xlLocationAsObject, Name:="Graph"
     
    ' # Boucle pour remettre les dates
    For Each PlageX In Graphik.Range(Graphik.Cells(6, 3), Graphik.Cells(6, Graphik.Cells(6, 3).End(xlToRight).Column))
        PlageX = Replace(PlageX.Value, "'", "")
    Next
    End Sub

  6. #6
    Membre confirmé
    Étudiant
    Inscrit en
    Juin 2010
    Messages
    125
    Détails du profil
    Informations personnelles :
    Âge : 36

    Informations professionnelles :
    Activité : Étudiant
    Secteur : Transports

    Informations forums :
    Inscription : Juin 2010
    Messages : 125
    Par défaut
    Ca marche super !

    Merci beaucoup Zyhack.

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Amelioration code VBA
    Par yannoch123 dans le forum Macros et VBA Excel
    Réponses: 3
    Dernier message: 14/03/2013, 10h05
  2. Faire varier les plages d'un graphique avec du code vba?
    Par Hydex dans le forum Macros et VBA Excel
    Réponses: 3
    Dernier message: 03/07/2007, 15h19
  3. Création automatique de code LaTeX de graphiques
    Par rafat dans le forum Tableaux - Graphiques - Images - Flottants
    Réponses: 6
    Dernier message: 17/08/2006, 14h10
  4. Réponses: 1
    Dernier message: 03/05/2006, 10h17
  5. afficher un graphique dans word à partir de mon code vba
    Par guysocode dans le forum VBA Word
    Réponses: 2
    Dernier message: 07/11/2005, 14h15

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo