Graphique - Superposition des étiquettes de données

J'aurais à nouveau besoin de votre aide... j'ai trouvé une macro qui permet d'éviter la superposition des étiquettes de données dans un graphique (je la met en PJ- - "Superposition Etiquettes.xlsm").

Dans le fichier en PJ on peut voir que cela fonctionne pour un graphique de type "nuage de points" or je souhaite l'adapter à un graphique de type "nuage de points avec lignes droites et marqueurs".

J'ai donc essayé de l'utiliser sur mon fichier Excel (aussi en PJ - "Graphique.xlsm"). La macro ne plante pas mais une fois qu'elle a finie de s'exécuter mes étiquettes de données sont toujours superposées, elles se sont juste légèrement déplacées vers le haut.

Merci d'avance

PS : je précise que mes séries ont des valeurs différentes les unes des autres en abscisses même si ça ne se voit pas sur mon screen.

Up

C'est bon j'ai trouvé un moyen de résoudre le problème je partage la macro dés fois qu'elle serve à quelqu'un :

Sub AjusterValeurs()
    Dim cht As Chart
    Dim dl As DataLabel
    Dim i As Long, j As Long
    Dim xDist As Double, yDist As Double
    Dim shiftDist As Double

    ' Modifier la distance de mouvement
    shiftDist = 0.5

    Set cht = ActiveSheet.ChartObjects(1).Chart

    ' Loop through each series
    For i = 1 To cht.SeriesCollection.Count
        ' Loop through each data label in each series
        For j = 1 To cht.SeriesCollection(i).Points.Count
            Set dl = cht.SeriesCollection(i).Points(j).DataLabel

            ' Loop through each series again, to compare each label to every other label
            Dim i2 As Long, j2 As Long
            For i2 = 1 To cht.SeriesCollection.Count
                For j2 = 1 To cht.SeriesCollection(i2).Points.Count
                    ' Don't compare a label to itself
                    If i2 <> i Or j2 <> j Then
                        ' Calculate the x and y distance between the two labels
                        xDist = dl.Left - cht.SeriesCollection(i2).Points(j2).DataLabel.Left
                        yDist = dl.Top - cht.SeriesCollection(i2).Points(j2).DataLabel.Top
                        ' If the labels overlap, move the label
                        If Abs(xDist) <= dl.Width And Abs(yDist) <= dl.Height Then
                            dl.Left = dl.Left + IIf(xDist <= 0, -1, 1) * shiftDist * dl.Width
                            dl.Top = dl.Top + IIf(yDist <= 0, -1, 1) * shiftDist * dl.Height
                        End If
                    End If
                Next j2
            Next i2
        Next j
    Next i
End Sub

Merci ChatGPT ;)

pour le partage de solution trouvée hors du forum.
Ce n'est pas toujours le cas ....

N'oubliez pas de mettre le sujet à Résolu, même si c'est "Auto-résolu"