XL 2016 Macro pour empêcher superposition étiquettes sur nuage de points [RESOLU]

Brain Box · 17 Octobre 2017

Bonjour (ou bonsoir, c'est selon !) au forum

Je viens solliciter votre connaissance de VBA pour un problème - à priori - simple (même si mon explication parait longue !) : je souhaite éviter le chevauchement d'étiquettes sur les nuages de points créés sous Excel.

Je m'explique : je crée mon nuage de points de manière standard sous Excel, avec des coordonnées X et Y. Dans un second temps j'ajoute les libellés via l'excellent XY Chart Labeler. Puis me voilà bien embête car lorsque les coordonnées sont proches entre les points, les libellés se chevauchent.
Miracle de Google, j'ai pu trouver sur un forum anglophone une macro permettant de corriger partiellement ce défaut (--> ce lien : https://stackoverflow.com/questions/8770429/excel-macro-to-fix-overlapping-data-labels-in-line-chart ; 2ème macro en bas de page).

Mais, car il y a toujours un 'mais', la macro ne fonctionne que sur les graphiques présents dans une feuille de calcul, et deuxièmement uniquement pour les points de la série 1. Je pense bien avoir repéré les problèmes à la lecture du code, mais je ne suis malheureusement pas assez débrouillard pour bricoler une solution alternative...

Mon rêve serait donc une solution à ces deux problèmes :
1) la capacité de faire fonctionner la macro même sur une page graphique (et/ou sur le graphique actif dans le cas où il y aurait plusieurs graphiques sur une même feuille de calcul) ;
2) appliquer la macro sur toutes les séries de données du graphique et pas seulement la première.

Le nec plus ultra serait également d'approfondir la macro en permettant des redimensionnements d'étiquettes si besoin (en cas de longs libellés), mais c'est irréalisable je pense.

Si un expert du VBA se trouve parmi vous, je serai ravi d'avoir ses lumières sur mon problème.

Bonne soirée à tous !

Maxence

job75 · 18 Octobre 2017

Bonjour Brain Box, le forum,

Si l'on ne veut pas que les étiquettes se superposent il suffit d'en afficher une seule à la fois !

Le code du module de classe :

Code:

Public WithEvents CH As Chart

Private Sub CH_MouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long)
Dim ElementID As Long, Arg1 As Long, Arg2 As Long
RAZ 'macro dans Module1
CH.GetChartElement X, Y, ElementID, Arg1, Arg2 'élément graphique sous le pointeur de la souris
If ElementID = 3 Then
  CH.SeriesCollection(Arg1).Points(Arg2).Select
  Selection.DataLabel.Height = 10
End If
End Sub

La classe est initialisée à l'ouverture du fichier :

Code:

Dim CH() As New Classe1

Private Sub Workbook_Open()
Dim s As Object, co As Object, n%
For Each s In Sheets
  If TypeOf s Is Chart Then
    ReDim Preserve CH(n)
    Set CH(n).CH = s
    n = n + 1
  Else
    For Each co In s.ChartObjects
      ReDim Preserve CH(n)
      Set CH(n).CH = co.Chart
      n = n + 1
    Next co
  End If
Next s
End Sub

Fichier joint, j'ai ajouté des feuilles pour tester.

Bonne journée.

Brain Box · 18 Octobre 2017

Bonjour !

Merci pour ta réponse rapide (tutoiement sur le forum ?) ! Je viens de regarder ta solution, qui fonctionne bien chez moi de ce que j'ai pu en voir.

Cela me fait penser que je n'ai pas tout expliqué, malgré mon premier message assez dense : il se trouve que ces nuages de points ont vocation à atterrir dans un document Powerpoint, ce qui de fait rend impossible l'utilisation de ta macro dans mon cas précis. Par ailleurs, l'idée d'un graphique à libellés dynamiques est très intéressante (on la retrouve dans certains logiciels de traitements statistiques), mais n'est pas non plus adaptée à mon cas précis : j'ai bel et bien besoin d'avoir tous les libellés affichés !

La macro présentée dans mon fichier fait déjà un très bon travail en ce sens, mais elle souffre de deux limites comme indiqué dans mon premier message (traite uniquement la première série et ne fonctionne pas sur les feuilles graphiques).

Merci beaucoup pour ta contribution en tous cas, cela aidera sûrement quelqu'un dans le futur !

Bonne journée également,

Maxence

job75 · 18 Octobre 2017

Re,

Votre macro RearrangeScatterLabels est compliquée et n'est guère efficace au vu du résultat sur le graphique de la feuille de calcul (où il n'y a qu'une série).

A+

Brain Box · 18 Octobre 2017

Re-bonjour,

Je vous confirme que c'est compliqué (d'ailleurs je ne l'ai pas écrite comme indiqué plus haut), parce que le but est difficile à atteindre : définir une position idéale est une tâche difficile à réaliser pour un ordinateur (déjà que pour moi... alors pour un ordinateur ! ).

Concernant le fichier que j'ai proposé, j'avais déjà testé la macro dessus bien entendu, donc les libellés sont un peu plus arrangés qu'au départ. Voici un exemple plus parlant. Mais je reste d'accord avec vous qu'il est surement possible de mieux faire ! En l'état, même non optimisée, cette macro fait le boulot (en dehors des deux points que je cherche à corriger).

Cordialement,

Maxence

Brain Box · 18 Octobre 2017

Bonsoir Nicole Bisson,

J'ai bien regardé votre macro, qui fonctionne bien au demeurant, mais je pense que cela ne m'aidera pas dans ma quête. Je peux déjà très facilement adapter le format des cellules (remplissage, police...) avec les différentes séries sans passer par VBA.

Le plus simple est encore de repartir de la macro existante (1er fichier) et de l'optimiser pour qu'elle puisse traiter plus d'une série et qu'elle fonctionne sur les feuilles graphiques, non ?

Merci en tous cas pour vos contributions !

Maxence

job75 · 20 Octobre 2017

Bonjour Brain Box, Nicole, le forum,

Après 2 jours d'absence je repasse par ici et j'ai téléchargé mon fichier du post #2.

Curieusement chez moi Excel plante quand on clique sur un point d'un graphique.

Excel ne plante pas si l'on ne cherche pas à sélectionner le point, voyez ce fichier (2) :

Code:

Private Sub CH_MouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long)
Dim ElementID As Long, Arg1 As Long, Arg2 As Long
RAZ 'macro dans Module1
On Error Resume Next
CH.GetChartElement X, Y, ElementID, Arg1, Arg2 'élément graphique sous le pointeur de la souris
If ElementID = 3 Then CH.SeriesCollection(Arg1).Points(Arg2).DataLabel.Height = 10
End Sub

Quant à votre problème de superposition BrainBox je ne comprends pas que vous vous obstiniez.

Il est évident que s'il y a beaucoup de points très proches les uns des autres les étiquettes seront forcément illisibles, et en supposant qu'on trouve des emplacements pour les rendre lisibles elles seront trop éloignées de leurs points pour que ça présente un intérêt quelconque.

A+

Brain Box · 23 Octobre 2017

Bonjour à tous,

Je reviens après quelques jours d'absence (voyage à l'étranger oblige !) pour répondre et essayer de faire avancer le débat :

Effectivement la macro RAZ plantait au bout de quelques libellés (je n'avais pas testé aussi longuement), cette nouvelle version à l'air de mieux fonctionner.
Dire que le positionnement des libellés par macro ne sera jamais parfait relève de l'évidence, je suis d'accord avec vous et tout à fait conscient des limites de la méthode. Néanmoins, comme je l'ai précisé au dessus, c'est d'une part pour raisons professionnelles (comme cela et pas autrement si vous voyez ce que je veux dire), d'autre part le support de présentation est Powerpoint, votre macro ne fonctionnant donc plus.

Je suis néanmoins surpris par le débat que tout cela suscite, je cherchais simplement un moyen de rajouter une boucle for / for each (ou autre) pour que la macro actuelle parcoure toutes les séries de mon graphique. J'ai visiblement été mal compris.

Merci à tous, je pense que le plus simple est encore que je passe quelques jours sur le document.

Bonne journée !

Maxence

job75 · 23 Octobre 2017

Bonjour Brain Box,

Si le but c'est de faire une présentation PowerPoint mettez-y une animation montrant l'affichage de l'étiquette quand on clique sur un point.

Ce sera moins insipide qu'un graphique à moitié illisible et sans aucun intérêt.

A+

Brain Box · 24 Novembre 2017

Bonjour à tous,

Je déterre un peu le sujet car j'ai eu quelques jours pour travailler sur la macro, et j'ai trouvé réponse à mes questions à force d'essais. Je poste le code ici pour les quelques personnes qui seraient intéressées à l'avenir. Cela ne fait pas des miracles bien entendu, mais ne serait-ce que pour le défi je voulais trouver la réponse.

Si un jour j'ai du temps peut être que je travaillerais à optimiser la position des étiquettes, mais c'est un tout autre travail.

Bonne journée à tous !

Maxence

Cheyenne_2021 · 16 Mars 2021

Bonjour,
Brain Box, j'ai testé votre macro et j'ai quelques soucis, notamment de division par 0 sur cette ligne :
dE = dE - wgtDistance / ((xArr(i) - xArr(j)) ^ 2 + (yArr(i) - yArr(j)) ^ 2)

J'ai créé un graphique qui est une cartographie des risques, il y a donc de nombreux point exactement identiques. Les étiquettes sont donc superposées exactement, on n'en voit qu'une. Je cherche un moyen pour les espacer de façon automatiques.
Merci

Brain Box · 17 Mars 2021

Bonjour,
Cette situation est connue, les points dont les coordonnées sont strictement identiques posent problème.
Rien n'est prévu à ce jour, j'ai migré vers d'autres solutions logicielles, mais ne vous privez pas d'améliorer l'outil si vous en avez le temps

Bonne journée,
Maxence

Cheyenne_2021 · 17 Mars 2021

Je vous remercie de votre réponse. C'est bien ennuyeux qu'il n'existe rien à ce jour dans Excel. Les autres solutions logicielles que vous utilisez sont-elles toutes payantes ?
Quant à améliorer l'outil, mon niveau ne me le permet pas.

Pme83 · 6 Juin 2023

Bonjour à tous ! Et pardon pour le déterrage...

J'ai essayé cette macro qui fait exactement ce que je cherche à obtenir. J'ai donc essayé de l'utiliser sur mon fichier Excel. Elle ne plante pas mais une fois qu'elle a finie de s'exécuter mes étiquettes de données sont toujours superposées.
Je précise que comparer au graphique présent dans le fichier ci-dessus mon graphique est de type "nuage de points avec lignes droites et marqueur".

L'un d'entre-vous aurait-il une solution ?

Merci.

Edit : 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

XL 2016 Macro pour empêcher superposition étiquettes sur nuage de points [RESOLU]

Brain Box

XLDnaute Nouveau

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

Brain Box

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Brain Box

XLDnaute Nouveau

Pièces jointes

Brain Box

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Pièces jointes

Brain Box

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Brain Box

XLDnaute Nouveau

Pièces jointes

Cheyenne_2021

XLDnaute Junior

Brain Box

XLDnaute Nouveau

Cheyenne_2021

XLDnaute Junior

Pme83

XLDnaute Nouveau

Discussions similaires