Etiquettes de donnée (seulement les plus élevées)

[DonMerlito]

Bonjour à tous,

Sur une graphique camembert, je voudrais que seules les trois valeurs les plus élevées bénéficient d'une étiquette de donnée. (Les autres valeurs doivent être présente dans le graphique, mais sans étiquette). Il faudrait par contre que cette opération soit automatique, et c'est la que je sèche.

Je joins un fichier exemple, avec ce que j'attend.

D'avance merci

 

[job75]

Re : Etiquettes de donnée (seulement les plus élevées)

Bonjour DonMerlito,

Je ne vois pas d'autre solution que du VBA :

Sub Etiquettes()
Dim deb As Range, n&, a1, a2, a3, i&
Set deb = [B1]
With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1)
  n = .Points.Count
  a1 = Application.Max(deb.Resize(n))
  a2 = Application.Large(deb.Resize(n), 2)
  a3 = Application.Large(deb.Resize(n), 3)
  .HasDataLabels = True
  .DataLabels.ShowValue = False
  .DataLabels.ShowPercentage = True
  For i = 1 To n
    If deb(i) <> a1 And deb(i) <> a2 And deb(i) <> a3 Then .Points(i).DataLabel.Delete
  Next
End With
End Sub

A+

 

[job75]

Re : Etiquettes de donnée (seulement les plus élevées)

Re,

J'oubliais les noms des catégories :

Sub Etiquettes()
Dim deb As Range, n&, a1, a2, a3, i&
Set deb = [B1]
With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1)
  n = .Points.Count
  a1 = Application.Max(deb.Resize(n))
  a2 = Application.Large(deb.Resize(n), 2)
  a3 = Application.Large(deb.Resize(n), 3)
  .HasDataLabels = True
  .DataLabels.ShowCategoryName = True
  .DataLabels.ShowValue = False
  .DataLabels.ShowPercentage = True
  For i = 1 To n
    If deb(i) <> a1 And deb(i) <> a2 And deb(i) <> a3 Then .Points(i).DataLabel.Delete
  Next
End With
End Sub

A+

 

[job75]

Re : Etiquettes de donnée (seulement les plus élevées)

Re,

Si l'on veut automatiser placer dans le code de la feuille (clic droit sur l'onglet et Visualiser le code) :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim X As Range, Y As Range, n&, y1, y2, y3, i&
Set X = [A1]: Set Y = [B1]
With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1)
  .XValues = Range(X, Cells(Rows.Count, X.Column).End(xlUp))
  .Values = Range(Y, Cells(Rows.Count, Y.Column).End(xlUp))
  n = .Points.Count
  y1 = Application.Max(Y.Resize(n))
  y2 = Application.Large(Y.Resize(n), 2)
  y3 = Application.Large(Y.Resize(n), 3)
  .HasDataLabels = True
  .DataLabels.ShowCategoryName = True
  .DataLabels.ShowValue = False
  .DataLabels.ShowPercentage = True
  For i = 1 To n
    If Y(i) <> y1 And Y(i) <> y2 And Y(i) <> y3 Then .Points(i).DataLabel.Delete
  Next
End With
End Sub

La série est redéfinie ainsi que les étiquettes si l'on modifie/valide [Edit] une cellule quelconque.

A+

 

[job75]

Re : Etiquettes de donnée (seulement les plus élevées)

Re,

En fait j'ai cru voir que les DataLabels.Show... ne sont valables que pour Excel 2013.

Désolé je n'ai pas Excel 2007 pour adapter, à vous de voir.

Bonne nuit.

 

[job75]

Re : Etiquettes de donnée (seulement les plus élevées)

Bonjour DonMerlito, le forum,

DataLabel.Text fonctionne quelle que soit la version Excel donc utiliser :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim X As Range, Y As Range, r As Range, s#, y1#, y2#, y3#, i&
Set X = [A1]: Set Y = [B1]
With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1)
  .XValues = Range(X, Cells(Rows.Count, X.Column).End(xlUp))
  .Values = Range(Y, Cells(Rows.Count, Y.Column).End(xlUp))
  Set r = Y.Resize(.Points.Count)
  s = Application.Sum(r): If s = 0 Then s = 1
  y1 = Application.Max(r)
  If Application.Count(r) > 1 Then y2 = Application.Large(r, 2)
  If Application.Count(r) > 2 Then y3 = Application.Large(r, 3)
  .HasDataLabels = True
  For i = 1 To r.Count
    If Y(i) = y1 Or Y(i) = y2 Or Y(i) = y3 Then _
      .Points(i).DataLabel.Text = X(i) & vbLf & Round(100 * Y(i) / s) & "%" _
        Else .Points(i).DataLabel.Delete
  Next
End With
End Sub

Bonne journée.

 

[DonMerlito]

Re : Etiquettes de donnée (seulement les plus élevées)

Bonjour Job75,

Merci pour ton implication, je teste ça cet après-midi et je te tiens au courant!

Bonne journée

 

[DonMerlito]

Re : Etiquettes de donnée (seulement les plus élevées)

Re,

Ca marche parfaitement ! Merci beaucoup !

Une dernière question, est-il possible d'afficher en plus des étiquettes des 3 valeurs les plus élevées, les étiquettes des valeurs qui sont annotées d'un x en colonne C?
ci-joint le fichier avec le résultat attendu

Merci encore,

PS: Peux-tu laisser des commentaires dans ton code, car celui-ci est assez ardu à comprendre pour moi

 

[job75]

Re : Etiquettes de donnée (seulement les plus élevées)

Re,

Je préfère modifier la dernière version :

Sub Etiquettes()
Dim X As Range, Y As Range, Z As Range, r As Range, s#, y1#, y2#, y3#, i&
Set X = [a1]: Set Y = [B1]: Set Z = [C1]
With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1)
  .XValues = Range(X, Cells(Rows.Count, X.Column).End(xlUp))
  .Values = Range(Y, Cells(Rows.Count, Y.Column).End(xlUp))
  Set r = Y.Resize(.Points.Count)
  s = Application.Sum(r): If s = 0 Then s = 1
  y1 = Application.Max(r)
  If Application.Count(r) > 1 Then y2 = Application.Large(r, 2)
  If Application.Count(r) > 2 Then y3 = Application.Large(r, 3)
  .HasDataLabels = True
  For i = 1 To r.Count
    If Y(i) = y1 Or Y(i) = y2 Or Y(i) = y3 Or Z(i) <> "" Then _
      .Points(i).DataLabel.Text = X(i) & vbLf & Round(100 * Y(i) / s) & "%" _
        Else .Points(i).DataLabel.Delete
  Next
End With
End Sub

Cette macro peut être lancée par une Worksheet_Change, à mon avis c'est mieux qu'un bouton.

A+

 

[job75]

Re : Etiquettes de donnée (seulement les plus élevées)

Re,

J'ai mieux cherché : les DataLabels.Show... existent tous même sur Excel 2003.

Donc tranquillou :

Sub Etiquettes()
Dim X As Range, Y As Range, Z As Range, r As Range, s#, y1#, y2#, y3#, i&
Set X = [A1]: Set Y = [B1]: Set Z = [C1]
With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1)
  .XValues = Range(X, Cells(Rows.Count, X.Column).End(xlUp))
  .Values = Range(Y, Cells(Rows.Count, Y.Column).End(xlUp))
  Set r = Y.Resize(.Points.Count)
  s = Application.Sum(r): If s = 0 Then s = 1
  y1 = Application.Max(r)
  If Application.Count(r) > 1 Then y2 = Application.Large(r, 2)
  If Application.Count(r) > 2 Then y3 = Application.Large(r, 3)
  .HasDataLabels = True
  .HasLeaderLines = True
  .DataLabels.ShowCategoryName = True
  .DataLabels.ShowValue = False
  .DataLabels.ShowPercentage = True
  For i = 1 To r.Count
    If Y(i) <> y1 And Y(i) <> y2 And Y(i) <> y3 And Z(i) = "" Then _
      .Points(i).DataLabel.Delete
  Next
End With
End Sub

Edit : ajouté .HasLeaderLines = True (lignes d'étiquettes).

Bonne fin de soirée.

 

[DonMerlito]

Re : Etiquettes de donnée (seulement les plus élevées)

Bonjour job75,

Ca marche parfaitement ! Merci beaucoup !! Je te dis si jamais j'ai des soucis pour adapter le code à mon fichier.

Bonne journée.

edit : j'ai réussi. Merci encore pour ton aide