Créer un graphe à bulles avec une macro

Version imprimable

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:

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 :)

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

Code:

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

18/06/2014, 10h59
keepcalm

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.
18/06/2014, 11h05
mercatog

Joins un fichier exemple fidèle au tiens
18/06/2014, 11h31
keepcalm

1 pièce(s) jointe(s)

J'arrive pas à joindre le fichier avec les macros donc voici le fichier, il faut remplacer "Feuil3" par "Feuil1" dans le code.
18/06/2014, 11h57
mercatog

Je n'ai aucune erreur

Ton Fichier
18/06/2014, 12h06
keepcalm

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

Il faudra agir sur les graduations

Code:

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

18/06/2014, 14h39
keepcalm

C'est bon :) Merci beaucoup !!
18/06/2014, 14h45
mercatog

C'est pas bon, tous les moins n'ont pas 30 jours
18/06/2014, 14h49
keepcalm

Ah oui, en fait j'ai dû mettre 31 et ça a marché
18/06/2014, 14h55
keepcalm

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 ?
18/06/2014, 15h03
mercatog

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?
18/06/2014, 15h08
keepcalm

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 ?

Code:

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

18/06/2014, 15h20
keepcalm

ça marche très bien !!! Merci du fond du coeur :)
19/06/2014, 15h24
keepcalm

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 :(

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:

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

24/06/2014, 16h56
keepcalm

Ok, merci beaucoup :)