Label associé à un nom de variable
Bonjour à tous, étant débutant sur vba, j'aurai voulu savoir comment placer un label en fonction d'une "valeur" sur un graph.
En effet comme vous pouvez le voir sur mon graph (voir en lien), j'ai réalisé un histogramme en fonction des moyennes pondérées de mes catégories. La première macro réalisé dessus était de ne pas prendre en compte dans le calcul de la moyenne pondéré si une des variable était dite "non applicable" car elle avait la valeur 0 et comme son nom l'indique, n'était pas applicable. J'ai donc dans ce graph placé les "maximum" et "minimum" pour chaque catégorie (sécurité, prévention etc...).
C'est là que mon problème ce pose, étant maladroit avec les labels/étiquettes et voulant placer une petite étiquette "NA" lorsque l'un des minimums vaut 0 à cause de la classification "non applicable" et pas "inadéquate", j'aimerai que cela soit lié à un bouton qui puisse activer la macro et place donc un petit "NA" juste au dessus du petit rond en minimum.
Les notes pouvant varier, je ne veux pas le faire manuellement car pour 3 variables cela est rapide mais pour beaucoup plus cela devient compliqué...
En espérant avoir été clair, voici la tableur excel:
Bonjour,
Essayez ceci:
Sub Etiquette_NA()
Dim Nb_Elements As Long, i As Long
On Error Resume Next
Nb_Elements = (Range("B1").End(xlToRight).Column - 2) / 2
ActiveSheet.ChartObjects("Graphique 7").Activate
With ActiveChart.SeriesCollection(3)
.DataLabels.Delete
.ApplyDataLabels
For i = 1 To Nb_Elements
If .Points(i).DataLabel.Text = "0" Then
.Points(i).DataLabel.Text = "NA"
End If
Next i
End With
End Sub
Cdlt
Bonjour, merci de votre réponse. Le programme marche mais pas tout à fait comme il faudrait, en effet, lorsqu'il y a un 0, votre programme place un "NA" à coté du 0 mais je souhaiterai que le "NA" ne soit placé uniquement si le 0 provient d'un "non applicable" comme pour le point H2 par exemple.
est ce que cela pourrai marcher avec un :
For i = 1 To Nb_Elements
If .Points(i).DataLabel.Text = "Non applicable" Then
.Points(i).DataLabel.Text = "NA"
End If
?
En attendant votre réponse,
Cordialement
Petite question supplémentaire, comment placer l'étiquette juste au dessus du point et pas à sa droite?
Merci d'avance, cordialement.
Pour l'étiquette au-dessus, ajouter la ligne suivante (en rouge)
ActiveSheet.ChartObjects("Graphique 7").Activate
With ActiveChart.SeriesCollection(3)
.DataLabels.Delete
.ApplyDataLabels
.DataLabels.Position = xlLabelPositionAbove
For i = 1 To Nb_Elements
If .Points(i).DataLabel.Text = "0" Then
.Points(i).DataLabel.Text = "NA"
End If
Next i
End With
Pour le reste ,je ne sais pas pour le moment, je dois m'absenter, je regarderai plus tard.
Bonjour,
Je vous ai un peu oublié, mais voici la réponse à votre problème (Remplacement des étiquettes à 0 correspondant à "Non applicable" par "NA").
Sub Etiquette_NA()
Dim i As Long, j As Long, k As Long
On Error Resume Next
DerLig = f1.Range("A1").CurrentRegion.Rows.Count
For i = 1 To 2 'pour chaque collection
For j = 1 To 3 'pour chaque point de chaque collection
ActiveSheet.ChartObjects("Graphique 7").Activate
k = Application.WorksheetFunction.Choose(j, 4, 6, 8)
If Cells(i + 1, k) = 0 Then
ActiveSheet.ChartObjects("Graphique 7").Activate
If Cells(i + 1, k - 1) = "Non applicable" Then
With ActiveChart.SeriesCollection(i + 1).Points(j)
.ApplyDataLabels
.DataLabel.Text = "NA"
End With
Else
With ActiveChart.SeriesCollection(i + 1).Points(j)
.ApplyDataLabels
.DataLabel.Text = Cells(i + 1, k)
End With
End If
End If
Next j
ActiveSheet.ChartObjects("Graphique 7").Activate
ActiveChart.SeriesCollection(i + 1).DataLabels.Position = xlLabelPositionAbove
Next i
End Sub
Cdlt
merci pour votre réponse cela fonctionne!
J'en profite pour abuser un peu de vos connaissance pour le même type de question mais avec un dossier plus "complexe".
En effet, je cherche à effacer les 0 qui sont les étiquettes d'une série de donnée (la 4) correspondant donc au pourcentage de NA si il y en a (ici le 50 représente 50%de NA), voici le graph :
malheureusement c'est un projet professionnel et je ne peux donc pas fournir le fichier excel mais cela correspond à une version plus imposante de donnée que celui fourni plus haut qui est simplifié.
j'ai donc essayé d'effacer les 0 qui ne servent à rien ici pour uniquement garder le 50 mais cela ne marche absolument pas. Voici le code que j'ai essayé :
ActiveSheet.ChartObjects("Graphique 1").Activate
YAAT_IncLabel = 3
For Each YAAT_ChartPoint In ActiveChart.FullSeriesCollection(4).Points
If YAAT_YearAccountItems.Cells(YAAT_IncLabel, 16) = 0 Then
YAAT_ChartPoint.Select
DataLabel.Delete
End If
Next YAAT_ChartPoint
En espérant que malgré le peu d'information que je peux donner, cela puisse mettre quelqu'un sur la voie.
Merci d'avance pour toute aide apportée,
Cordialement
Bonjour,
Pas besoin du fichier réel, par contre, un fichier avec un tableau de données bidons serait le bienvenu, avec la même structure que le fichier réel, ce qui me permettrait de travailler sur un support concret.
Cdlt
Bonjour,
En attendant votre pseudo fichier, voici à quoi pourrait ressembler votre code, ce n'est qu'une extrapolation de ce que j'imagine d'après l'image du graphique, il est bien certain que ce ne doit pas être exactement comme cela, mais faute de mieux !!!
Sub Etiquette_50()
Dim i As Long, j As Long, k As Long
On Error Resume Next
DerLig = f1.Range("A1").CurrentRegion.Rows.Count
DerCol = f1.Range("A1").CurrentRegion.Columns.Count
Nb_Collect = DerLig - 1
Nb_Pts = (DerCol - 2) / 2
For i = 1 To Nb_Collect 'pour chaque collection
For j = 1 To Nb_Pts 'pour chaque point de chaque collection
ActiveSheet.ChartObjects("Graphique 1").Activate
k = Application.WorksheetFunction.Choose(j, 4, 6, 8, 10, 12, 14, 16, 18, 20, 22, 24, 26, 28, 30, 32, 34, 36, 38, 40, 42, 44, 46, 48, 50, 52, 54)
If Cells(i + 1, k) = 0 Then
ActiveSheet.ChartObjects("Graphique 1").Activate
If Cells(i + 1, k - 1) <> 0 Then
With ActiveChart.SeriesCollection(i + 1).Points(j)
.ApplyDataLabels
.DataLabel.Text = Cells(i + 1, k)
End With
End With
End If
End If
Next j
ActiveSheet.ChartObjects("Graphique 1").Activate
ActiveChart.SeriesCollection(i + 1).DataLabels.Position = xlLabelPositionAbove
Next i
End Sub
Cdlt
Bonjour, tout d'abord merci pou votre réponse et je m'excuse pour la mienne qui est tardive.
J'ai finalement réussi à réaliser ce que je voulais de manière moins efficace mais au moins cela fonctionne :
Worksheets("PD All Risks Items Evaluation").ChartObjects("Graphique 1").Activate
ActiveChart.SeriesCollection(4).Select
ActiveChart.SeriesCollection(4).DataLabels.Select
ActiveChart.SeriesCollection(4).Points(1).DataLabel.Select
If Cells(3, 16).Value = 0 Then
ActiveChart.SeriesCollection(4).Points(1).DataLabel.Delete
Else
ActiveChart.FullSeriesCollection(4).Points(1).DataLabel.Text = (YAAT_YearAccountPDAllRiskItemEval.Cells(3, 16)) & "%" & "NA"
End If
ActiveChart.SeriesCollection(4).Points(2).DataLabel.Select
If Cells(4, 16).Value = 0 Then
ActiveChart.SeriesCollection(4).Points(2).DataLabel.Delete
Else
ActiveChart.FullSeriesCollection(4).Points(2).DataLabel.Text = (YAAT_YearAccountPDAllRiskItemEval.Cells(4, 16)) & "%" & "NA"
End If
'etc... jusqu'au 27 ème point
ActiveChart.SeriesCollection(4).Points(27).DataLabel.Select
If Cells(29, 16).Value = 0 Then
ActiveChart.SeriesCollection(4).Points(27).DataLabel.Delete
Else
ActiveChart.FullSeriesCollection(4).Points(27).DataLabel.Text = (YAAT_YearAccountPDAllRiskItemEval.Cells(29, 16)) & "%" & "NA"
End If
Seul bémol, cette ligne :
Else
ActiveChart.FullSeriesCollection(4).Points(1).DataLabel.Text = (YAAT_YearAccountPDAllRiskItemEval.Cells(3, 16)) & "%" & "NA"
End If
En effet, les 0 s'effacent donc bien comme prévu même si j'ai du répéter cela pour les 27 points mais lors du "else", je n'arrive pas à faire correspondre la valeur appartenant à "
(YAAT_YearAccountPDAllRiskItemEval.Cells(3, 16))
" qui correspond donc à la valeur calculé si la valeur est supérieur à 0. Toujours la même phrase est affiché "objet requis" alors que la syntaxe est supposée être bonne. Qu'en pensez vous ?
En vous remerciant pour tout ce qui a déjà été fait et le temps que vous m'avez accordé.
Cordialement.
Bonjour,
C'est délicat de répondre correctement sans connaître la structure du fichier, toutefois votre ligne en défaut devrait s'écrire ainsi, % et NA accolés:
Else
ActiveChart.FullSeriesCollection(4).Points(1).DataLabel.Text = (YAAT_YearAccountPDAllRiskItemEval.Cells(3, 16)) & "%NA"
End If
Mais est-ce bien ce que vous voulez?
De plus, je serai tenter d'écrire quelque chose comme ceci(mais je ne peux pas le vérifier)
Else
Valeur=sheets(""PD All Risks Items Evaluation").cells(3,16) & "%NA"
ActiveChart.FullSeriesCollection(4).Points(1).DataLabel.Text = Valeur
Dommage que vous ne mettiez pas à disposition une copie (sans données confidentielles) de votre fichier, j'aurais repris votre code et éviter ainsi de faire 27 fois la même chose, alors qu'une boucle qui tournerait 27 fois ferait l'affaire et réduirait considérablement la taille de votre code tout en le rendant plus lisible.
Cdlt