Créer un graphe à bulles avec une macro

**keepcalm** · 17/06/2014, 18h23

Bonjour tout le monde,

Je vous présente mon problème. Je dois créer un graphe à bulles avec sur l'axe X une date de création de liste, sur l'axe Y un numéro de types de listes (par exemple liste de finance correspond au numéro 3), et la taille de la bulle le nombre de participants à la liste.
J'ai un tableau dont la taille est variable, car je rajoute automatiquement des lignes au tableau à chaque rajout de liste. Chaque ligne du tableau correspond à une bulle avec le nom de la liste, la date de création, le numéro de liste, et le nombre des participants.

J'ai déjà fait une tentative de macro pour créer mon graphe dans un onglet dédié mais il m'affiche après exécution :
"La méthode cells de l'objet global a échoué" et pointe vers la ligne 12 de mon code ci-dessous:

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
Sub graph()
 
Dim u As Long
Dim w As Long
For u = 2 To 100
For w = 1 To 100
Sheets("Feuil3").Range("B2:E250").Select
Charts.Add
ActiveChart.ChartType = xlBubble
ActiveChart.SetSourceData Source:=Sheets("Feuil3").Range("B2:E250"), PlotBy:= _
xlRows
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(w).XValues = Cells(u, 2)
ActiveChart.SeriesCollection(w).Values = Cells(u, 3)
ActiveChart.SeriesCollection(w).BubbleSizes = Cells(u, 4)
ActiveChart.SeriesCollection(w).Name = Cells(u, 1)
ActiveChart.Location Where:=Sheets("Feuil3")
With ActiveChart
.HasTitle = False
.Axes(xlCategory, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).HasTitle = False
End With
Next w
Next u
End Sub

Merci pour votre aide

**mercatog** · 17/06/2014, 22h21

1. Tu n'as pas besoin des Select
2. Tu peux créer directement un objet graphique sur ta feuille

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
Option Explicit
 
Sub Graph()
Dim LastLig As Long, i As Long
Dim Ch As Chart
Dim DATA
 
Application.ScreenUpdating = False
With Worksheets("Feuil3")
    Set Ch = .ChartObjects.Add(240, 50, 600, 340).Chart
    With Ch
        .ChartArea.ClearContents
        .ChartType = xlBubble
        .HasTitle = False
        'pour supprimer la légende
        '.HasLegend = False
        .Axes(xlCategory, xlPrimary).HasTitle = False
        .Axes(xlValue, xlPrimary).HasTitle = False
        .Axes(xlCategory).TickLabels.NumberFormat = "dd/mm/yyyy"
    End With
 
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    For i = 2 To LastLig
        DATA = .Range("A" & i).Resize(, 4)
        With Ch.SeriesCollection.NewSeries
            .Name = DATA(1, 1)
            .BubbleSizes = DATA(1, 4)
            .Values = DATA(1, 3)
            .XValues = CLng(DATA(1, 2))
            'Pour inscrire le nom des bulles
'            .ApplyDataLabels
'            .DataLabels.ShowSeriesName = True
'            .DataLabels.ShowValue = False
        End With
    Next i
End With
Set Ch = Nothing
End Sub

**keepcalm** · 18/06/2014, 10h59

Merci pour ta réponse.

Quand j'essaie d'exécuter ton code, j'ai une erreur 1004 :"Erreur définie par l'application ou par l'objet" et il me pointe vers la ligne ".Values= DATA(1,3)". Je ne comprends pas ce problème. Peux-tu m'aider stp?

Merci.

**mercatog** · 18/06/2014, 11h05

Joins un fichier exemple fidèle au tiens

**keepcalm** · 18/06/2014, 11h31

J'arrive pas à joindre le fichier avec les macros donc voici le fichier, il faut remplacer "Feuil3" par "Feuil1" dans le code.

**mercatog** · 18/06/2014, 11h57

Je n'ai aucune erreur

Ton Fichier

**keepcalm** · 18/06/2014, 12h06

Est-ce que l'axe horizontal t'affiche 2 fois le mois d'août et 2 fois le mois de mai?

**mercatog** · 18/06/2014, 12h46

Il faudra agir sur les graduations

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()
Dim LastLig As Long, i As Long
Dim Mn As Long, Mx As Long
Dim Ch As Chart
Dim DATA
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    Mn = Application.Min(.Range("B2:B" & LastLig))
    Mx = Application.Max(.Range("B2:B" & LastLig))
    Set Ch = .ChartObjects.Add(240, 50, 600, 340).Chart
    With Ch
        .ChartArea.ClearContents
        .ChartType = xlBubble
        .HasTitle = False
        .HasLegend = False
        .Axes(xlValue, xlPrimary).HasTitle = False
        With .Axes(xlCategory, xlPrimary)
            .HasTitle = False
            .TickLabels.NumberFormat = "mmm yyyy"
            .MinimumScale = Mn - 30
            .MaximumScale = Mx + 30
            .MajorUnit = 30
        End With
    End With
 
    For i = 2 To LastLig
        DATA = .Range("A" & i).Resize(, 4)
        With Ch.SeriesCollection.NewSeries
            .Name = DATA(1, 1)
            .BubbleSizes = DATA(1, 4)
            .Values = DATA(1, 3)
            .XValues = CLng(DATA(1, 2))
 
            .ApplyDataLabels
            .DataLabels.ShowSeriesName = True
            .DataLabels.ShowValue = False
        End With
    Next i
End With
Set Ch = Nothing
End Sub

**keepcalm** · 18/06/2014, 14h39

C'est bon

Merci beaucoup !!

**mercatog** · 18/06/2014, 14h45

C'est pas bon, tous les moins n'ont pas 30 jours

**keepcalm** · 18/06/2014, 14h49

Ah oui, en fait j'ai dû mettre 31 et ça a marché

**keepcalm** · 18/06/2014, 14h55

je risque d'être un peu lourde, mais est-ce que qu'il y a un moyen de donner dans le même code une couleur aux bulles ?

**mercatog** · 18/06/2014, 15h03

Une même couleur pour toutes les bulles ou un couleur différente par bulle.

Si des couleurs différentes, comment affecter à chaque bulle une couleur? aléatoirement?

**keepcalm** · 18/06/2014, 15h08

En effet, j'ai coloré mes cellules avec des couleurs spécifiques (exemple : liste achats et support ont la même couleur, finance une autre couleur etc.).
Je veux que la couleur de la bulle soit la même que la cellule. C'est possible ?

**mercatog** · 18/06/2014, 15h14

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
Option Explicit
Sub Graph()
Dim LastLig As Long, i As Long
Dim Mn As Long, Mx As Long, Klr As Long
Dim Ch As Chart
Dim DATA
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    Mn = Application.Min(.Range("B2:B" & LastLig))
    Mx = Application.Max(.Range("B2:B" & LastLig))
    Set Ch = .ChartObjects.Add(240, 50, 600, 340).Chart
    With Ch
        .ChartArea.ClearContents
        .ChartType = xlBubble
        .HasTitle = False
        .HasLegend = False
        .Axes(xlValue, xlPrimary).HasTitle = False
        With .Axes(xlCategory, xlPrimary)
            .HasTitle = False
            .TickLabels.NumberFormat = "mmm yyyy"
            .MinimumScale = Mn - 30
            .MaximumScale = Mx + 30
            .MajorUnit = 31
        End With
    End With
 
    For i = 2 To LastLig
        DATA = .Range("A" & i).Resize(, 4)
        Klr = .Range("A" & i).Interior.Color
        With Ch.SeriesCollection.NewSeries
            .Name = DATA(1, 1)
            .BubbleSizes = DATA(1, 4)
            .Values = DATA(1, 3)
            .XValues = CLng(DATA(1, 2))
            .Format.Fill.ForeColor.RGB = Klr
            .ApplyDataLabels
            .DataLabels.ShowSeriesName = True
            .DataLabels.ShowValue = False
            .DataLabels.Font.Color = Klr
        End With
    Next i
End With
Set Ch = Nothing
End Sub

**keepcalm** · 18/06/2014, 15h20

ça marche très bien !!! Merci du fond du coeur

**keepcalm** · 19/06/2014, 15h24

Est-ce que le nom du graphe est "Ch" ? Car j'ai l'impression que Excel lui donne un nom par défaut, par exemple "Graphique1", et incrémente à chaque fois que j'en crée un.

Or, j'ai besoin soit de lui donner un nom fixe à chaque fois soit de supprimer l'ancien au début de la macro pour qu'il puisse avoir le même nom à chaque création.

J'ai essayé avec ActiveChart.Delete mais ça ne marche pas

**mercatog** · 19/06/2014, 15h37

Sur ta feuille tu as plusieurs graphiques ou un seul?

Si tu as plusieurs et tu veux supprimer que celui portant ce nom et en créer un nouveau. Ou bien tu as ton graphique et tu veux seulement le modifier

Tout est possible et à toi de choisir

par exemple

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
Sub Graph()
Dim LastLig As Long, i As Long
Dim Mn As Long, Mx As Long, Klr As Long
Dim Ch As ChartObject
Dim DATA
 
Application.ScreenUpdating = False
With Worksheets("Feuil3")
    On Error Resume Next
    .ChartObjects("TonNom").Delete
    On Error GoTo 0
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    Mn = Application.Min(.Range("B2:B" & LastLig))
    Mx = Application.Max(.Range("B2:B" & LastLig))
    Set Ch = .ChartObjects.Add(240, 50, 600, 340)
    With Ch
        .Name = "TonNom"
        With .Chart
            .ChartArea.ClearContents
            .ChartType = xlBubble
            .HasTitle = False
            .HasLegend = False
            .Axes(xlValue, xlPrimary).HasTitle = False
            With .Axes(xlCategory, xlPrimary)
                .HasTitle = False
                .TickLabels.NumberFormat = "mmm yyyy"
                .MinimumScale = Mn - 30
                .MaximumScale = Mx + 30
                .MajorUnit = 31
            End With
        End With
    End With
 
    For i = 2 To LastLig
        DATA = .Range("A" & i).Resize(, 4)
        Klr = .Range("A" & i).Interior.Color
        With Ch.Chart.SeriesCollection.NewSeries
            .Name = DATA(1, 1)
            .BubbleSizes = DATA(1, 4)
            .Values = DATA(1, 3)
            .XValues = CLng(DATA(1, 2))
            .Format.Fill.ForeColor.RGB = Klr
            .ApplyDataLabels
            .DataLabels.ShowSeriesName = True
            .DataLabels.ShowValue = False
            .DataLabels.Font.Color = Klr
        End With
    Next i
End With
Set Ch = Nothing
End Sub

PS. personnellement, je préfère modifier un graphique que le supprimer et le re-créer

**keepcalm** · 24/06/2014, 16h56

Ok, merci beaucoup

Créer un graphe à bulles avec une macro [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager