[Excel] Macro Graphique Camenberts Résolu

Question

Bonjour,  

Je voulais savoir si il était possible de ne pas afficher les étiquettes de données si leur valeur est égale a Zéro. 

En effet je desire faire une presentation avec camembert pour plusieur machines les données change et des fois sont egale a 0 j'ai reussi a suprimer l'apparition du 0 grace a la mise en forme 0;; mais il reste les etiquettes de données regoupées les une sur les autre. 
J'ai vu une possibilitée de ce genre mais je ne la comprend pas un peu d'aide serai la bien venue 
For Each p In ActiveChart.SeriesCollection(1).Points 
            If Mid(p.DataLabel.Text, 7, 2) = 0 Then p.HasDataLabel = False 
Merci 


Configuration: Windows XP / Firefox 4.0.1

elglouton · Answer

Personne çà ne doit pas être possible c'est bien dommage...
Un exemple tout de meme
https://www.excel-downloads.com/forums/forum-excel.7/

pépé35530 · Answer

Bonjour,

Quand tu cliques une première fois sur tes étiquettes, elles sont toutes sélectionnées. Si tu recliques alors sur l'une d'elle, seule cette dernière est active. Tu peux alors la supprimer.

A+

pépé

tontong · Answer

Bonjour,
Il y a une solution mais elle me parait complexe par rapport à la proposition de pépé 35530. Je ne suis pas sûr de pouvoir l'expliquer dans tous ses détails.
Dans les grandes lignes:
1* Créer par des formules un tableau secondaire qui élimine les valeurs nulles et vides.
2* Nommer les champs de ce tableau secondaire avec en référence une fonction DECALER. Ceci permet d'avoir des champs ajustés et dynamiques.
 
Pour avoir lu vos questions précédentes voici quelques principes que j'essaye d'appliquer pour avoir des graphiques "parlants":
Pas plus de 6 parts (8 grand max) dans un camembert. ;-)
Une dizaine de données pour un "secteur +histogramme"
Au delà il ne reste que les histogrammes dont l'axe Ox doit présenter une notion d'ordre: ordre chronologique, ordre alphabétique, ordre des valeurs triées, ordre logique (du producteur à l'utilisateur par exemple). Tout ceci n'est qu'un avis personnel!

ccm81 · Answer

bonjour à tous

une tentative avec macros 

http://www.cijoint.fr/cjlink.php?file=cj201105/cijyEGFkBT.xls

bonne suite

ccm81 · Answer

re
ton fichier est en effet très lourd !!
comme les données des graphiques sont calculées, il y a, du moins je crois, avec worksheet_change un pb avec la MAJ des etiquettes
je te suggere de mettre un bouton (controle activeX) dans chaque feuille où il y a des graphiques à traiter et de lui affecter le code comme ci-dessous

Private Sub CommandButton2_Click()
Dim nbgr As Long, nugr As Long
nbgr = ActiveSheet.ChartObjects.Count
For nugr = 1 To nbgr
  Call RemetEtiquettes(nugr)
  Call SupprimeEtiquetteNulle(nugr)
Next nugr
End Sub

où les deux procedures RemetEtiquettes et SupprimeEtiquetteNulle sont celles que tu as déjà

RQ. je n'ai pas essayé dans ton classeur

bonne suite

ccm81 · Answer

re
nbpoints = .SeriesCollection(1).Points.Count 
donne le nombre de points de la série de données 

dans ta feuille graph il y a des graphiques sans serie de données
le pb vient certainement de là!
donc 
Etape 1. vérifies avec le bouton qui permet de voir quels sont les graphiques a traiter et quelle série de donnée leur est attachée
Etape 2. modifier eventuellement la procedure (du bouton)pour ne traiter que les "bons graphs"

RQ. sinon, il y a une solution : gérer l'erreur produite dans ce cas avec un "on error goto" 

Public Sub SupprimeEtiquetteNulle(NumGraph)
Dim nbpoints As Long, nupoint As Long
Dim ValY
On Error GoTo fin
With ChartObjects(NumGraph).Chart
  nbpoints = .SeriesCollection(1).Points.Count
  ValY = .SeriesCollection(1).Values
  For nupoint = 1 To nbpoints
    If ValY(nupoint) = 0 Then
      .SeriesCollection(1).Points(nupoint).DataLabel.Delete
    End If
  Next nupoint
End With
fin:
End Sub

et 

Public Sub RemetEtiquettes(NumGraph)
On Error GoTo fin
  ChartObjects(NumGraph).Chart.ApplyDataLabels ShowCategoryName:=True, HasLeaderLines:=True
fin:
End Sub

bonne suite

ccm81 · Answer

re

1. dans le module de la feuille qui contient les données

Option Explicit

Private Sub CommandButton1_Click()
Dim nugr As Long
  nugr = Range("nugr").Value
  ActiveSheet.ChartObjects(nugr).Select
End Sub

Private Sub CommandButton2_Click()
  Call Traite("Feuil1")
  Call Traite("F1")
  Call Traite("F2")
End Sub

à toi de modifier/ajouter les noms des feuilles a traiter 

2. Puis insertion/nouveau module

Option Explicit

Public Sub SupprimeEtiquetteNulle(NomFeuille, NumGraph)
Dim nbpoints As Long, nupoint As Long
Dim ValY
On Error GoTo fin
With Sheets(NomFeuille).ChartObjects(NumGraph).Chart
  nbpoints = .SeriesCollection(1).Points.Count
  ValY = .SeriesCollection(1).Values
  For nupoint = 1 To nbpoints
    If ValY(nupoint) = 0 Then
      .SeriesCollection(1).Points(nupoint).DataLabel.Delete
    End If
  Next nupoint
End With
fin:
End Sub

Public Sub RemetEtiquettes(NomFeuille, NumGraph)
On Error GoTo fin
  Sheets(NomFeuille).ChartObjects(NumGraph).Chart.ApplyDataLabels ShowCategoryName:=True, HasLeaderLines:=True
fin:
End Sub

Public Sub Traite(NF As String)
Dim nbgr As Long, nugr As Long
nbgr = Sheets(NF).ChartObjects.Count
For nugr = 1 To nbgr
  Call RemetEtiquettes(NF, nugr)
  Call SupprimeEtiquetteNulle(NF, nugr)
Next nugr
End Sub
De cette façon on passe les noms des feuilles à traiter à la procedure Traite(NF) qui elle meme passe le nom de la feuille aux procedures Remet et Supprime

bonne suite

ccm81 · Answer

re
Cette cellule (nommée "nugr" dans la feuille) est utilisée par le bouton qui permet de reperer les graphiques selon la valeur (1, 2, ...) de cette cellule. En fait ce bouton servait dans l'option choisie au départ d'utiliser worksheet_change, mais ce n'est plus d'actualité.
Je suppose que tu n'utilises plus ce bouton, donc tu peux supprimer la procedure ou du moins la désactiver en mettant toutes les lignes en commentaire (ajouter un ' devant chaque ligne)
bonne suite

ccm81 · Answer

re

c'est posible, on compte le nb de pts nuls, et s'il est egal au nb de points on suuprime le titre

Public Sub SupprimeEtiquetteNulle(NomFeuille, NumGraph)
Dim nbpoints As Long, nupoint As Long, nbpointsnuls As Long
Dim ValY
On Error GoTo fin
nbpointsnuls = 0
With Sheets(NomFeuille).ChartObjects(NumGraph).Chart
  nbpoints = .SeriesCollection(1).Points.Count
  ValY = .SeriesCollection(1).Values
  For nupoint = 1 To nbpoints
    If ValY(nupoint) = 0 Then
      .SeriesCollection(1).Points(nupoint).DataLabel.Delete
      nbpointsnuls = nbpointsnuls + 1
    End If
  Next nupoint
  If nbpointsnuls = nbpoints Then
    .HasTitle = False
  End If
End With
fin:
End Sub

bon après midi

ccm81 · Answer

re    
aïe, c'est vrai que c'est un peu plus délicat.    

.Hastitle = True est la bonne propriété mais si ça autorise le titre, ça ne le récupère pas    

Option1. attribuer au nom de la serie de chaque graphique le titre souhaité, ce que tu n'as pas fait  (clic sur le graphique/données source/series/nom)  puis modifier RemetEtiquettes comme ci dessous    

Option2. faire quelque part une liste des titres selon les n° de graphique     

RQ. dans les deux cas, il va bien falloir les ecrires ces titres, donc l'option 1 est la plus propre    

  If nbpointsnuls = nbpoints Then    
    .HasTitle = False    
  Else    
    .HasTitle = True    
    .ChartTitle.Characters.Text = .SeriesCollection(1).Name    
  End If
bonne suite

[Excel] Macro Graphique Camenberts

10 réponses

Discussions similaires

Newsletters