[XL-2007] Etiquette graphe nuage de points [Résolu]

[zemblamoh]

* Bonjour, *

J’ai crée un vba me permettant de traiter un graphe nuage de point. Ce code me crée une feuille graphique à part qui traite les données issues de quelques feuilles. Mais je n’arrive pas à insérer les étiquettes (texte) liées à l’une des feuilles ("villes" dans ce cas) . Tout ce que j’ai trouvé dans les forums ce sont des codes qui traitent des graphes insérer dans une même feuille de donnée.
J’insère mon code à ce stade (sans étiquettes) que j’ai développé avec l’aide de ce forum :

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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
Sub Macro1()
Dim Ch As Chart
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'
On Error Resume Next
Sheets("CartMaroc").Delete
On Error GoTo 0
Application.DisplayAlerts = True
'
Set Ch = Charts.Add(after:=Worksheets("MarContPoint"))
With Ch
    .Name = "CartMaroc"
    .ChartType = xlXYScatter
    .SetSourceData Source:=Worksheets("MarContPoint").Range("A2:B898")
    .SeriesCollection(1).Name = "Contour_Maroc"
    .Axes(xlValue).MinimumScale = 20
    .ChartStyle = 2
    '
    With .SeriesCollection(1)
        .MarkerStyle = 2
        .MarkerSize = 2
        'couleur des marqueurs
        .MarkerBackgroundColor = RGB(25, 25, 25)
        .MarkerForegroundColor = RGB(25, 25, 25)
    End With
 End With
'
Dim i As Integer
'
With ActiveChart
    .PlotArea.Select
    .ChartType = xlXYScatter
    .SeriesCollection.NewSeries
    .SeriesCollection(2).Name = "=""Villes"""
    .SeriesCollection(2).XValues = "='Villes'!$C$2:$C$64"
    .SeriesCollection(2).Values = "='Villes'!$D$2:$D$64"
    With .SeriesCollection(2)
        .MarkerStyle = 2
        .MarkerSize = 2
        'couleur des marqueurs
    End With
    'quadrillage
    .SetElement (msoElementPrimaryCategoryGridLinesMajor)
    'axe principaux horiz. en dot
    With ActiveChart.Axes(xlValue)
    If .HasMajorGridlines Then
        .MajorGridlines.Border.LineStyle = xlDot
        .MajorGridlines.Border.ColorIndex = 5  'set color to blue
    End If
    End With
    'axe verticaux. en dot
    With ActiveChart.Axes(xlCategory)
    If .HasMajorGridlines Then
        .MajorGridlines.Border.LineStyle = xlDot
        .MajorGridlines.Border.ColorIndex = 5 '
    End If
    End With
    '
End With
 
'
Set Ch = Nothing
End Sub

Merci pour votre aide.

[mercatog]

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 Macro1()
Dim Ch As Chart
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Sheets("CartMaroc").Delete
On Error GoTo 0
Application.DisplayAlerts = True
 
Set Ch = Charts.Add(after:=Worksheets("MarContPoint"))
With Ch
    .Name = "CartMaroc"
    .ChartType = xlXYScatter
    .SetSourceData Source:=Worksheets("MarContPoint").Range("A2:B898")
    .Axes(xlValue).MinimumScale = 20
    .ChartStyle = 2
 
    With .SeriesCollection(1)
        .Name = "Contour_Maroc"
        .MarkerStyle = 2
        .MarkerSize = 2
        .MarkerBackgroundColor = RGB(25, 25, 25)
        .MarkerForegroundColor = RGB(25, 25, 25)
    End With
 
    With .SeriesCollection.NewSeries
        .Name = "Villes"
        .XValues = "='Villes'!C2:C64"
        .Values = "='Villes'!D2:D64"
        .MarkerStyle = 2
        .MarkerSize = 2
        .ApplyDataLabels
    End With
 
    .SetElement (msoElementPrimaryCategoryGridLinesMajor)
    With .Axes(xlValue)
        If .HasMajorGridlines Then
            .MajorGridlines.Border.LineStyle = xlDot
            .MajorGridlines.Border.ColorIndex = 5
        End If
    End With
    With .Axes(xlCategory)
        If .HasMajorGridlines Then
            .MajorGridlines.Border.LineStyle = xlDot
            .MajorGridlines.Border.ColorIndex = 5
        End If
    End With
End With
Set Ch = Nothing
End Sub

[zemblamoh]

Merci pour votre réponse,
Le code est mieux structuré que ce que j'avais fait, mais ma quête aussi était d'affecter des étiquettes à mes points. Pas un des coordonnées des points "villes" mais le nom de la ville qui se trouve en colonne "b".
la syntaxe insérée me crée des l'étiquette x.

Code :

.ApplyDataLabels

Pouvez vous m'indiquer la procédure pour y arriver. J'ai fait toute les tentatives en m'insiprant du code suivant, mais sans résultat. Et comme je l'avais dit dans ma 1ère question ce code fonctionne pour un graphe inséré dans la même feuille que les données:

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
compteur = 1
    i = 4
    While IsEmpty(Range("A" & i)) = False
    compteur = compteur + 1
    i = i + 1
    Wend
 
    ActiveSheet.ChartObjects("Graphique 14").Activate
    N = 1
    If Not ActiveChart.SeriesCollection(1).HasDataLabels Then ActiveChart.SeriesCollection(1).ApplyDataLabels
    For i = 1 To compteur - 1
        etiquette = Range("D" & N + 3).Text
        ActiveSheet.ChartObjects("Graphique 14").Activate
        ActiveChart.SeriesCollection(1).Points(i).DataLabel.Characters.Text = etiquette
        N = N + 1
   Next i

Merci encore

[mercatog]

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
52
53
54
55
56
57
58
59
60
61
Sub Macro1()
Dim Ch As Chart
Dim i As Integer
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Sheets("CartMaroc").Delete
On Error GoTo 0
Application.DisplayAlerts = True
 
Set Ch = Charts.Add(after:=Worksheets("MarContPoint"))
With Ch
    'Type et caractéristiques graphique
    .Name = "CartMaroc"
    .ChartType = xlXYScatter
    .Axes(xlValue).MinimumScale = 20
 
    'Seie 1
    With .SeriesCollection.NewSeries
        .Name = "Contour_Maroc"
        .XValues = "='MarContPoint'!A2:A898"
        .Values = "='MarContPoint'!B2:B898"
        .MarkerStyle = 2
        .MarkerSize = 3
        .MarkerBackgroundColor = vbBlue
    End With
 
    'Série 2
    With .SeriesCollection.NewSeries
        .Name = "Villes"
        .XValues = "='Villes'!C2:C64"
        .Values = "='Villes'!D2:D64"
        .MarkerStyle = 2
        .MarkerSize = 3
        .MarkerBackgroundColor = vbRed
 
        'Application des étiquettes
        .ApplyDataLabels
        For i = 1 To .Points.Count
            With .Points(i).DataLabel
                .Text = Worksheets("Villes").Range("B" & i + 1)
                .Font.Size = 9
                .Font.Name = "Calibri"
            End With
        Next i
    End With
 
    'Axes primaires
    .SetElement 334                              'msoElementPrimaryCategoryGridLinesMajor
    With .Axes(xlValue).MajorGridlines.Border
        .LineStyle = xlDot
        .ColorIndex = 5
    End With
    With .Axes(xlCategory).MajorGridlines.Border
        .LineStyle = xlDot
        .ColorIndex = 5
    End With
End With
Set Ch = Nothing
End Sub

[zemblamoh]

Bonjour,
Merci pour votre réponse. J'ai testé le code et ça a marché. Seulement quand j'ai voulu le tester de nouveau il a bolqué au niveau de:

Code :

.SetSourceData Source:=Worksheets("MarContPoint").Range("A2:B898")

Avec le message suivant:

Erreur d'exécution '1004'
Le nombre maximal de séries de données par graphique est de 255

Pouvez vous m'éclairer s'il vous plait. Je ne comprends pas ce message alors que les séries créées sont de deux.
Merci

[mercatog]

As tu testé le code #4 tel? J'avais pas mis SetSourceData

En plus, tu as mis la fin des données en dur 898. Est ce que tu as toutes ces données ou on peut se limiter au nombre exact de lignes.

Le cas échéant au cas où tu n'arrive pas à adapter le code, mettre ton fichier sans données confidentielles en PJ

[zemblamoh]

Bonjour,
Entre temps j'ai fait remarcher le programme.
J'ai rien touché à ce que vous m'avez donné. Tout ce que j'ai fait en dernier pour tester ce message, c'est que j'ai demandé la création manuelle de mon 1er graphe. Il a été crée sans problème. Après je suis revenu au module et je l'ai lancé, là surprise ça a de nouveau marché, je l'ai testé à maintes reprises et ça marche impeccablement.
Merci beaucoup