Etiquette d'une serie dans un graphique dynamique

chipriote

XLDnaute Occasionnel
Bonjour à tous,

Voilà mon problème, j'aimerais pouvoir modifier en automatique les étiquettes de mon graphique et ce quelque soit le nombre de série par un code en VBA.

Le fichier étant trop lourd je ne peux pas le faire suivre.

Esperant etre assez clair.

D'avance merci à tout ce qui se pencherons sur mon problème
 

chipriote

XLDnaute Occasionnel
Re : Etiquette d'une serie dans un graphique dynamique

Je vais essayé de reformuler:
J'aimerais pouvoir changer l'étiquette d'une série dans un graphique croisé dynamique par macro et ce de manière automatique quelque soit le nombre de donnée.
J'ai trouvé un code qui ne correspond pas vraiment à mes attentes car on est obligé a chaque fois de selectionner la série sur le graphique par clic et de choisir la cellule étiquette
Donc ma question c'est comment modifier le code ci-après pour le rendre automatique sans avoir à choisir continuellement la donnée source et cliqué sur la série et ceux quelque soit le nombre de série.

Code:
Sub AttribuerEtiquettes()
Dim maPlage As Variant, maCellule As Object, monPoint As Object
Dim nmGraphique$, nmSérie$, i%

' Détection du type de la fenêtre (xlGraphiqueDansEmplacement ou
' xlGraphiqueEnFenetre).
tpGraphique = ActiveWindow.Type

' Récupération du nom du graphique et de la série sélectionnée.
nmGraphique = ActiveChart.Parent.Name
nmSérie = Selection.Name

' Déselection du graphique incorporé pour pouvoir sélectionner
' une plage de cellules
If tpGraphique <> 1 Then ActiveWindow.Visible = False

' Sélection de la plage contenant les étiquettes
Set maPlage = Application.InputBox( _
Prompt:="Selectionnez la plage contenant les étiquettes :", _
Title:="Etiquettes", Type:=8)

' Réactivation du graphique incorporé
If tpGraphique <> 3 Then ActiveSheet.ChartObjects(nmGraphique).Activate

' Sélection de la série
ActiveChart.SeriesCollection(nmSérie).Select

' Quitte si on a annulé la boîte
If VarType(maPlage) = vbBoolean Then Exit Sub

' Initialisation d'un compteur
i = 1

' Quitte si on a plus de cellules que de points
If maPlage.Count > Selection.Points.Count Then
MsgBox Prompt:="Sélection non valide. Plage trop grande !", _
Buttons:=vbCritical
Exit Sub
End If
Application.ScreenUpdating = False
With Selection
For Each maCellule In maPlage
Set monPoint = .Points(i)

' On initialise l'étiquette avec une référence de cellule
' ceci permettra d'avoir une liaison
With monPoint
.ApplyDataLabels Type:=xlShowValue
.DataLabel.Text = "=" & maCellule.Address _
(ReferenceStyle:=xlR1C1, External:=True)
End With
i = i + 1
Next
End With
End Sub

Merci d'avance pour votre aide car je tourne en rond depuis pas mal de temps
 

Cousinhub

XLDnaute Barbatruc
Re : Etiquette d'une serie dans un graphique dynamique

Bonjour,

Si tu n'as pas d'aide, c'est peut-être parce qu'on ne saisit pas bien ton problème, ou alors que faire un fichier rebute beaucoup de monde...

Peut-être qu'en joignant un fichier exemple, avec ce que tu désires, ça motiverait les bonnes âmes....

Peut-être???
 

chipriote

XLDnaute Occasionnel
Re : Etiquette d'une serie dans un graphique dynamique

Suite au conseil de bhbh, je transmet un exemple de ma demande en fichier joint.
Il faut cependant garder en tête que le tableau est à TCD contrairement à mon exemple (tableau manuel car TCD trop lourd)

Esperant etre plus clair
 

Pièces jointes

  • etiquette test.xls
    16 KB · Affichages: 119

Cousinhub

XLDnaute Barbatruc
Re : Etiquette d'une serie dans un graphique dynamique

Re-,

ce code fonctionne avec ton exemple....

J'ai défini la plage (Plg) :

Code:
Col = [IV1].End(xlToLeft).Column - 1
Set Plg = Range(Cells(1, 2), Cells(1, Col))

On calcule la dernière colonne, -1 pour la colonne Total
et on définit de A2 à Acol

Le code :

Code:
Sub etiq()
Dim ChO As ChartObject
Dim Plg As Range
Dim Col As Byte, NbSer As Byte
Range("A1").Select
Col = [IV1].End(xlToLeft).Column - 1
Set Plg = Range(Cells(1, 2), Cells(1, Col))
For Each ChO In ActiveSheet.ChartObjects
    If ChO.Chart.SeriesCollection.Count <> Plg.Count Then
        MsgBox "Pas cohérent"
        Exit Sub
    End If
    For NbSer = 1 To ChO.Chart.SeriesCollection.Count
        ChO.Chart.SeriesCollection(NbSer).Points(1).ApplyDataLabels Type:=xlShowValue
        ChO.Chart.SeriesCollection(NbSer).Points(1).DataLabel.Text = Plg(NbSer)
    Next NbSer
Next ChO
End Sub

Maintenant, si tu as du mal à l'adapter, il va falloir un exemple un peu plus proche de la vérité.
Dans ton exemple, il n'y a qu'un point par Série....
A voir avec ton fichier réel
 

chipriote

XLDnaute Occasionnel
Re : Etiquette d'une serie dans un graphique dynamique

Merci pour ton aide bhbh mais je n'arrive pas a adapter le code j'ai donc réduit la taille de mon fichier et je l'ai mis sur ci-joint voir lien ci-après

Cijoint.fr - Service gratuit de dépôt de fichiers
 

Cousinhub

XLDnaute Barbatruc
Re : Etiquette d'une serie dans un graphique dynamique

Re-,

essaie avec ce code :

Code:
Sub etiq()
Dim Pts As Point
Dim ChO As ChartObject
Dim Plg As Range
Dim NbSer As Byte
For Each ChO In ActiveSheet.ChartObjects
    For NbSer = 1 To ChO.Chart.SeriesCollection.Count
        For Each Pts In ChO.Chart.SeriesCollection(NbSer).Points
            Pts.ApplyDataLabels Type:=xlShowValue
            Pts.DataLabel.Text = Pts.Parent.Name
        Next Pts
    Next NbSer
Next ChO
End Sub
 

chipriote

XLDnaute Occasionnel
Re : Etiquette d'une serie dans un graphique dynamique

Merci beaucoup c'est super enfin ça fonctionne. Tu m'a retiré une sacré épine du pied.
Je me permet d'abuser en te demandant encore un p'tit coup de main concernant l'alignement à 90° de l'étiquette avec une police de 7
 

Cousinhub

XLDnaute Barbatruc
Re : Etiquette d'une serie dans un graphique dynamique

Re-,

essaie :

Code:
Sub etiq()
Dim Pts As Point
Dim ChO As ChartObject
Dim Plg As Range
Dim NbSer As Byte
For Each ChO In ActiveSheet.ChartObjects
    For NbSer = 1 To ChO.Chart.SeriesCollection.Count
        For Each Pts In ChO.Chart.SeriesCollection(NbSer).Points
            Pts.ApplyDataLabels Type:=xlShowValue
            With Pts.DataLabel
                .Text = Pts.Parent.Name
                .Font.Size = 7
                .Orientation = xlUpward
            End With
        Next Pts
    Next NbSer
Next ChO
End Sub
 

Discussions similaires

Réponses
6
Affichages
355

Statistiques des forums

Discussions
312 492
Messages
2 088 936
Membres
103 987
dernier inscrit
Doctami