Microsoft 365 Légende graph VBA

Pernin

XLDnaute Nouveau
Bonjour à tous.

J'ai un problème, donc je fais appel à vous. Je ne pas si la question a déjà été traitée (Sûrement), mais je ne trouve pas de topic en rapport.
J'aimerai pouvoir afficher le label "Series Name" à chaque barre correspondante dans mon graphique grâce à un code VBA. Je vous ai mis un fichier avec un pré-remplissage manuel pour que vous puissiez comprendre ce qui m'intéresse.
Je vous ai également ajouté le fichier avec le code qui permet de générer le graph. Tout est modifiable bien sûr. :)

Auriez-vous une solution ?

Je vous mets un fichier en PJ pour que vous compreniez.

Passez une excellente journée,

Cordialement,
Greg
 

Pièces jointes

  • TEST XLDL Graphique Avec Nom sans code.xlsm
    32.3 KB · Affichages: 8
  • TEST XLDL Graphique.xlsm
    35.1 KB · Affichages: 6

AtTheOne

XLDnaute Accro
Supporter XLD
Bonsoir à toutes et à tous, bonsoir @Pernin

Je ne connais pas de méthode dans l'interface utilisateur pour modifier simultanément les étiquettes de toutes les séries d'un graphique : Donc passage par VBA ...
J'ai repris le code de ta macro
Ancien Code :
VB:
Sub CréationGraphiqueIntégréAvecChartObjectXLDL()

Dim Graph As ChartObject
Dim n
Dim m
Dim nbG As Integer
nbG = 0
For Each Graph In Sheets("Résultat par projet").ChartObjects
nbG = 1 + nbG
Next Graph
If nbG > 0 Then
ActiveSheet.ChartObjects.Delete
End If

n = Range("E43").Value
m = Range("F43").Value
Dim graphiqueIntégré As ChartObject
Set graphiqueIntégré = Sheets("Résultat par projet").ChartObjects.Add(Left:=100, Width:=400, Top:=700, Height:=200)
graphiqueIntégré.Chart.SetSourceData Source:=Sheets("Résultat par projet").Range("P1:BB1" & ",P" & n & ":" & "BB" & n)
    graphiqueIntégré.Activate
   ActiveChart.ChartType = xlColumnClustered

End Sub

'"P" & m & ":" & "BB" & n

Nouveau Code :
Enrichi (BBcode):
Sub CréationGraphiqueIntégré()

     Dim GraphiqueIntégré As ChartObject, Wsh As Worksheet
     Dim n, m, a, MaxWidth As Double
     Set Wsh = ThisWorkbook.Sheets("Résultat par projet")
 
     With Wsh
          If .ChartObjects.Count > 0 Then .ChartObjects.Delete
          n = .Range("E43").Value
          m = .Range("F43").Value
     End With
 
     'Place pour écrire l'étiquette de la série de plus grande valeur
     MaxWidth = 0
 
     Set GraphiqueIntégré = Wsh.ChartObjects.Add(Left:=100, Width:=400, Top:=700, Height:=200)
     GraphiqueIntégré.Name = "Graphique Intégré"
 
     With GraphiqueIntégré.Chart
          .SetSourceData Source:=Sheets("Résultat par projet").Range("P1:BB1" & ",P" & n & ":" & "BB" & n)
          .HasLegend = False
          .ChartType = xlColumnClustered
          .SetElement (msoElementDataLabelOutSideEnd)
          For Each Série In .SeriesCollection
               '(pour ajustement des tailles Graphe et PlotArea)
               a = Série.Values
               MaxVal = WorksheetFunction.Max(a(1), MaxVal)
               If a(1) = MaxVal Then MaxWidth = WorksheetFunction.Max(Série.DataLabels(1).Width, MaxWidth)
               'Mise en forme des étiquettes (nom de série écrit verticalement)
               With Série.DataLabels
                     .ShowValue = False
                     .ShowSeriesName = True
                     .Orientation = xlUpward
                End With
          Next
     End With
 
     'Ajustements pour avoir toutes les étiquettes entièrement au dessus des séries
     With GraphiqueIntégré
          .Height = .Height + MaxWidth
          With .Chart.PlotArea
               .Height = .Height - MaxWidth
               .Top = .Top + MaxWidth
          End With
     End With

End Sub

Voir le classeur joint.
Bon courage, amicalement
Alain
 

Pièces jointes

  • Légende graph VBA.xlsm
    29.1 KB · Affichages: 2
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
315 098
Messages
2 116 193
Membres
112 679
dernier inscrit
Yupanki