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 :

Créer graphique dans zone de graphique =>Feuille de type graphique déjà existante !


Sujet :

Macros et VBA Excel

  1. #1
    Membre habitué
    Homme Profil pro
    Inscrit en
    Octobre 2010
    Messages
    338
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Rhône (Rhône Alpes)

    Informations forums :
    Inscription : Octobre 2010
    Messages : 338
    Points : 153
    Points
    153
    Par défaut Créer graphique dans zone de graphique =>Feuille de type graphique déjà existante !
    Bonjour,

    Je réalise un graphique selon ce code :

    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
    42
    43
    Sub Graph() 'Graphique :
     
        Dim G1 As Chart
        Dim ws1 As Worksheet
        Dim PlageDonnees1 As Range
        Dim PlageX1 As Range
        Dim PlageY1 As Range
        Dim MaSerie1 As Series
        Dim Compteur1 As Long
        Dim Col1 As Long
        Dim Lig1 As Long
     
        Set ws1 = ThisWorkbook.Worksheets("Feuille de données du graphique")
     
        Lig1 = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row 'Recherche la dernière ligne contenant une donnée
        Col1 = ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column - 1 'Recherche la dernière colonne contenant une donnée
     
        With ws1
            Set PlageDonnees1 = .Range(.Cells(1, 1), .Cells(Lig1, Col1)) ' Définition de la plage de données
        End With
        Set G1 = ThisWorkbook.Charts.Add 'Ajout d'une feuille MonGraphe au classeur
            G1.ChartArea.Clear 'Effacement des données du graphe
            G1.ChartType = xlXYScatter 'Définition du type de graphique (nuage de points)
        Set PlageX1 = PlageDonnees1.Columns(1)
        For Compteur1 = 1 To Col1
            Set PlageY1 = PlageX1.Offset(, Compteur1)
            Set MaSerie1 = G1.SeriesCollection.NewSeries
     
            With MaSerie1 'Formattage des séries de données
                .Values = PlageY1
                .XValues = PlageX1
                .Name = PlageDonnees1.Cells(1, 1).Offset(, Compteur1)
            End With
            With G1.Axes(xlCategory) 'axe des abscisses
                .HasTitle = True 'définition du titre des abscisses
                .AxisTitle.Characters.Text = "Nombre d'onde (cm-1)"
            End With
            With G1.Axes(xlValue) 'axe des  ordonnées
                .HasTitle = True 'définition du titre des ordonnées
                .AxisTitle.Characters.Text = "Absorbance (U.A.)"
            End With
        Next Compteur1
    End Sub
    Est il possible de le créer en lui donnant un nom de feuille de type graphique prédéfini ? (par exemple une feuille intitulée mon graphique).

    Par ailleurs si cette feuille contient déjà un graphique lui dire de l'effacer :

    structure de type

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    if Worsheet("mon graphique")<>"" then 'si graphique déjà créé sur la feuille mon graphique alors effacement du graphe
     
    worsheet.clearcontent
     
    end if
    Je ne sais pas si ces lignes de codes sont correctes?

    Merci d'avance pour votre aide

  2. #2
    Membre confirmé
    Profil pro
    Inscrit en
    Août 2010
    Messages
    345
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Août 2010
    Messages : 345
    Points : 539
    Points
    539
    Par défaut
    Bonjour,

    Essayer comme ça

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    Sub MonGraphe()
        Dim G1 As Chart
        On Error Resume Next
            Set G1 = ThisWorkbook.Charts("mon graphique") 'verif
        On Error GoTo 0
        If Not G1 Is Nothing Then
            G1.ChartArea.Clear 'Effacement des données du graphe
        Else
            Set G1 = ThisWorkbook.Charts.Add 'Ajout d'une feuille mon graphique au classeur
            G1.Name = "mon graphique"
        End If
        Set G1 = Nothing
    End Sub
    Cordilement

    ctac

  3. #3
    Membre habitué
    Homme Profil pro
    Inscrit en
    Octobre 2010
    Messages
    338
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Rhône (Rhône Alpes)

    Informations forums :
    Inscription : Octobre 2010
    Messages : 338
    Points : 153
    Points
    153
    Par défaut
    En fait je n'arrive pas à adapter ton code => il me renvoie l'erreur suivante :

    "Variable objet ou variable de bloc With non définie" avec les lignes situées sous ta partie de code surligné en jaune

    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
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    Sub Graph() 'Graphique :
     
        Dim G1 As Chart
        Dim ws1 As Worksheet
        Dim PlageDonnees1 As Range
        Dim PlageX1 As Range
        Dim PlageY1 As Range
        Dim MaSerie1 As Series
        Dim Compteur1 As Long
        Dim Col1 As Long
        Dim Lig1 As Long
        Set ws1 = ThisWorkbook.Worksheets("Feuille de données du graphique")
     
        Lig1 = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row 'Recherche la dernière ligne contenant une donnée
        Col1 = ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column - 1 'Recherche la dernière colonne contenant une donnée
     
        Lig1 = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row 'Recherche la dernière ligne contenant une donnée
     
        ws1.[A1] = "Nombre d'onde (cm-1)"
        ws1.[A1].Characters(Start:=18, Length:=2).Font.Superscript = True
     
         Application.ScreenUpdating = False
     
        With ws1
            Set PlageDonnees1 = .Range(.Cells(1, 1), .Cells(Lig1, Col1)) ' Définition de la plage de données
        End With
     
        On Error Resume Next
            Set G1 = ThisWorkbook.Charts("mon graphique") 'verif
        On Error GoTo 0
        If Not G1 Is Nothing Then
            G1.ChartArea.Clear 'Effacement des données du graphe
        Else
            Set G1 = ThisWorkbook.Charts.Add 'Ajout d'une feuille mon graphique au classeur
            G1.Name = "mon graphique"
        End If
        Set G1 = Nothing
     
            G1.ChartType = xlXYScatter 'Définition du type de graphique (nuage de points)
        Set PlageX1 = PlageDonnees1.Columns(1)
        For Compteur1 = 1 To Col1
        Set PlageY1 = PlageX1.Offset(, Compteur1)
        Set MaSerie1 = G1.SeriesCollection.NewSeries
     
            With MaSerie1 'Formattage des séries de données
                .Values = PlageY1
                .XValues = PlageX1
                .Name = PlageDonnees1.Cells(1, 1).Offset(, Compteur1)
                .Border.ColorIndex = 1 'Noir
                .Border.Weight = xlHairline
                .Border.LineStyle = xlContinuous
                .MarkerBackgroundColorIndex = xlNone
                .MarkerForegroundColorIndex = xlNone
                .MarkerStyle = xlNone
                .Smooth = False
                .MarkerSize = 3
                .Shadow = True
            End With
     
            G1.HasLegend = False
            G1.HasTitle = False
            With G1.Axes(xlCategory) 'axe des abscisses
                .HasTitle = True 'définition du titre des abscisses
                .AxisTitle.Characters.Text = "Nombre d'onde (cm-1)"
                .AxisTitle.Font.ColorIndex = 3
                .AxisTitle.Characters(Start:=18, Length:=2).Font.Superscript = True
                .AxisTitle.Font.Name = "Arial"
                .AxisTitle.Font.FontStyle = "Gras"
                .AxisTitle.Font.Size = 12
                .HasMajorGridlines = True 'Grille principale activée
                .HasMinorGridlines = True 'Grille secondaire activée
                .MajorGridlines.Border.ColorIndex = 16 'couleur de la grille principale
                .MajorGridlines.Border.Weight = xlHairline 'taille du trait de la grille principale
                .MajorGridlines.Border.LineStyle = xlDash 'type de trait de la grille principale
                .MinorGridlines.Border.ColorIndex = 15 'couleur de la grille secondaire
                .MinorGridlines.Border.Weight = xlHairline 'taille du trait de la grille secondaire
                .MinorGridlines.Border.LineStyle = xlDot 'type de trait de la grille secondaire
                .MinimumScale = 400 'valeur minimale
                .MaximumScale = 4000 'valeur maximale
                .MinorUnit = 50 'unité secondaire
                .MajorUnit = 200 'unité principale
                .Crosses = xlMaximum 'ordonnée à gauche
                .ReversePlotOrder = True 'échelle en ordre inverse
                .ScaleType = xlLinear
                .DisplayUnit = xlNone
                .MajorTickMark = xlCross 'position des unités principales
                .MinorTickMark = xlInside 'position des unités secondaires
                .TickLabelPosition = xlNextToAxis 'position des étiquette de données
                With .Border 'couleur et taille de l'axe
                    .ColorIndex = 3 'couleur rouge
                    .Weight = xlThin 'épaisseur
                    .LineStyle = xlContinuous 'type
                End With
                With .TickLabels.Font 'Formatage des étiquettes de données
                    .Name = "Arial" 'Police
                    .FontStyle = "Normal" 'formattage
                    .Size = 10 'taille
                    .Strikethrough = False 'barrée
                    .Superscript = False 'exposant
                    .Subscript = False 'indice
                    .OutlineFont = False '
                    .Shadow = False 'transparence
                    .Underline = xlUnderlineStyleNone 'souligné
                    .ColorIndex = 3 'couleur (3=Rouge)
                    .Background = xlAutomatic 'couleur du fond
                End With
            End With
     
            With G1.Axes(xlValue) 'axe des  ordonnées
                .HasTitle = True 'définition du titre des ordonnées
                .AxisTitle.Characters.Text = "Absorbance (U.A.)"
                .AxisTitle.Font.ColorIndex = 3
                .AxisTitle.Font.Name = "Arial"
                .AxisTitle.Font.FontStyle = "Gras"
                .AxisTitle.Font.Size = 12
                .HasMajorGridlines = True
                .HasMinorGridlines = True
                .MajorGridlines.Border.ColorIndex = 16 'couleur de la grille principale
                .MajorGridlines.Border.Weight = xlHairline 'taille du trait de la grille principale
                .MajorGridlines.Border.LineStyle = xlDash 'type de trait de la grille principale
                .MinorGridlines.Border.ColorIndex = 15 'couleur de la grille secondaire
                .MinorGridlines.Border.Weight = xlHairline 'taille du trait de la grille secondaire
                .MinorGridlines.Border.LineStyle = xlDot 'type de trait de la grille secondaire
                .MinimumScale = 0 'valeur minimale
                .MaximumScale = 3.5 'valeur maximale
                .MinorUnit = 0.1 'unité secondaire
                .MajorUnit = 0.5 'unité principale
                .Crosses = xlCustom 'Défini à quelle valeur l'axe X coupe l'axe Y
                .CrossesAt = 0 'Défini à quelle valeur l'axe X coupe l'axe Y
                .ReversePlotOrder = False 'échelle en ordre inverse
                .ScaleType = xlLinear
                .DisplayUnit = xlNonne
                .MajorTickMark = xlCross 'position des unités principales
                .MinorTickMark = xlInside 'position des unités secondaires
                .TickLabelPosition = xlNextToAxis 'position des étiquette de données
                With .Border 'couleur et taille de l'axe
                    .ColorIndex = 3 'couleur rouge
                    .Weight = xlThin 'épaisseur
                    .LineStyle = xlContinuous 'type
                End With
                With .TickLabels.Font 'Formatage des étiquettes de données
                    .Name = "Arial" 'Police
                    .FontStyle = "Normal" 'formattage
                    .Size = 10 'taille
                    .Strikethrough = False 'barrée
                    .Superscript = False 'exposant
                    .Subscript = False 'indice
                    .OutlineFont = False '
                    .Shadow = False 'transparence
                    .Underline = xlUnderlineStyleNone 'souligné
                    .ColorIndex = 3 'couleur (3=Rouge)
                    .Background = xlAutomatic 'couleur du fond
                End With
            End With
        Next Compteur1
     
        For Each MaSerie1 In G1.SeriesCollection
            MaSerie1.FormulaR1C1Local = Replace(MaSerie1.FormulaR1C1Local, "L1C", "L2C")
        Next MaSerie1
     
         Application.ScreenUpdating = True
     
    End Sub

  4. #4
    Membre confirmé
    Profil pro
    Inscrit en
    Août 2010
    Messages
    345
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Août 2010
    Messages : 345
    Points : 539
    Points
    539
    Par défaut
    Bonjour,

    Supprimer

    C'est pour liberer la mémoire a la fin quand on ne sert plus de la variable G1

    Cordialement

    ctac

  5. #5
    Membre habitué
    Homme Profil pro
    Inscrit en
    Octobre 2010
    Messages
    338
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Rhône (Rhône Alpes)

    Informations forums :
    Inscription : Octobre 2010
    Messages : 338
    Points : 153
    Points
    153
    Par défaut
    Merci pour ton aide ctac_

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

Discussions similaires

  1. créer une zone graphique dans une fenetre
    Par jlg75 dans le forum Windows
    Réponses: 12
    Dernier message: 13/01/2012, 00h04
  2. Réponses: 4
    Dernier message: 20/05/2008, 10h28
  3. Insertion de plusieurs graphiques dans une même feuille
    Par cmoicv dans le forum Macros et VBA Excel
    Réponses: 1
    Dernier message: 19/03/2008, 22h22
  4. créer un graphique dans un autre classeur
    Par n'anneso dans le forum Excel
    Réponses: 2
    Dernier message: 06/02/2008, 09h54
  5. créer un synonyme graphique dans un autre diagramme
    Par farenheiit dans le forum PowerAMC
    Réponses: 2
    Dernier message: 01/08/2007, 09h48

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