XL 2010 À propos d'une courbe. Comment diable s'y sont-ils bien pris ?

[Magic_Doctor]

Bonsoir,

Je tombe sur cet article. Ce n'est pas l'article en soi qui est intéressant, mais la 1ère courbe qu'il présente.
Je pense que ce doit être reproductible avec Excel. Personnellement, j'en suis incapable.

Il faut aller ici

 

[patricktoulon]

Bonjour @job75
relire le post#31 😉

 

[job75]

Bonjour @job75
relire le post#31 😉

Et relis le mien post #32, les valeurs du post #31 sont valables uniquement sur ton ordi, pas sur le mien.

 

[sylvanu]

Bonjour tout le monde,
Un essai en PJ sur un histogramme.
Je ne suis pas sur que le suivi souris soit indépendant de l'écran.
Pourriez vous tester ? Sur mon écran j'obtiens ça :

( en fait c'est juste pour comprendre la macro du lien du post #13 de Mapomme, toute une partie semble liée à la normalisation de X et Y )

 

[patricktoulon]

dans ce cas là il va falloir trouver le left réel en situation dynamique
mais le traitement du zoom est bon pour tous
je suis curieux de connaitre le left de l’élément interne dans le conteneur parent

@sylvanu même problème le max doit être le dernier pixel rouge a droite
et bien sur qu l’écran y fait d ou mon interrogation sur le fait de chercher le left 0 +les entête de l’abscisse et l'ordonnée
ps : non chez moi ça déconne

puré pour chopper ca avec un sheet graphique c'est coton

 

[mapomme]

Pourriez vous tester ?

ça ne marche pas bien. Gros retard sur l'affichage et il faut passer sur une autre barre pour que le label de la précédente s'affiche. Snif 😢

 

[job75]

dans ce cas là il va falloir trouver le left réel en situation dynamique

.Points(1).Left et .Points(.Points.Count).Left ne vont pas du tout, le 2ème chez moi donne plus de 84000...

 

[patricktoulon]

re
au puré c'est en pixel !!!!!! ben on est pas dans la mouise

je met un shape en bas a gauche et un autre sur le trait du départ du graph
ben mes amis c'est en pixel
et pour combler la drole d'histoire , ben mon astuce pttopix ne fonctionne pas sur un sheet graph
donc chez moi en DPI 120

Sub test()
'With ActiveWindow.ActivePane
  'P_ToPx = (.PointsToScreenPixelsY(72) - .PointsToScreenPixelsY(0)) / 72' ne fonctionne pas  sur un sheet graphique
 'End With
With ActiveSheet
For Each shap In ActiveSheet.Shapes
Debug.Print shap.Name
Next
'1.333333333333333 pour ceux qui sont en DPI 100 soit 96 ou (4/3)
Debug.Print (((.Shapes(2).Left - .Shapes(1).Left) * 1.6666666666667)) * (ActiveWindow.Zoom / 100)
End With

End Sub

j'obtiens bien la partie a décompter
regarder la caption de l'application

 

[patricktoulon]

et pour ceux qui n'ont pas peur de taper dans le registre en lecture

Sub test()
P_toPX = CreateObject("WScript.Shell").RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72
With ActiveSheet
For Each shap In ActiveSheet.Shapes
Debug.Print shap.Name
Next
'1.333333333333333 pour ceux qui sont en DPI 100 soit 96
Debug.Print (((.Shapes(2).Left - .Shapes(1).Left) * P_toPX)) * (ActiveWindow.Zoom / 100)
End With

End Sub

 

[patricktoulon]

voila
reste plus qu'a mettre comme je le fait dans la demo 3 shapes en leur donnanant un width de zero bien entendu je les ai laissé apparent pour la demo

Option Explicit

Private Sub Chart_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
Dim z#, q
On Error Resume Next
z = ActiveWindow.Zoom / 100
Application.Caption = x
If Not IsArray(q) Then q = GetdépartAndFinish
With Sheets("Base")
    .[C2:C3] = IIf(x < (q(1)) Or x > (q(2) * z), "#N/A", .Range("A" & Round(2 + 302 * (x - (q(1) * z)) / ((q(2) * z) - (q(1) * z)))))
    SeriesCollection(2).Points(2).DataLabel.Caption = Format(.Range("B" & Round(2 + 302 * (x - q(1)) / (q(2) - q(1)))), "0.000")
End With
Application.Caption = "depart à " & q(1) & "   fini à " & q(2) & "posision actuelle " & x & " par " & y
End Sub
Function GetdépartAndFinish()
Dim P_ToPx, x1, x2
P_ToPx = CreateObject("WScript.Shell").RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72
With ActiveSheet
x1 = (((.Shapes(2).Left - .Shapes(1).Left) * P_ToPx)) '* (ActiveWindow.Zoom / 100)'le zoom est appliqué dans le calcul dans le move
x2 = (.Shapes(3).Left * P_ToPx) '* (ActiveWindow.Zoom / 100)'le zoom est appliqué dans le calcul dans le move
GetdépartAndFinish = Array(" ", x1, x2)
End With

End Function

a non de dieu !!! 🤣 🤣 🤣 😉

 

[Magic_Doctor]

¡Caramba! Que de prose.

Quoi qu’il en soit, quand j’avais ouvert fortuitement cette page de cet illustre quotidien hexagonal, immédiatement, en bougeant la souris, j’avais vu l’effet au niveau de la courbe du 1er graphique. Ça me semblait donc évident. Voilà tout. Mais de là à en faire tout un pataquès, manifestement il y en a qui ont du temps à perdre, ou, je ne sais pas, qui sont un chouïa psychorigides. À ceux-là, je leur rappellerai qu’un forum est destiné avant tout au fun et non pas pour déverser des avalanches de réflexions inutiles dignes de vieux professeurs aigris à la retraite. Je leur conseillerai d’essayer la passiflore. C’est pas mal la passiflore… 😎

 

[job75]

Une autre solution, différente, à partir du fichier de sylvanu que je remercie 🙂

Voyez ce fichier survol graphique (2) qui utilise la méthode GetChartElement :

Private Sub Chart_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long)
Dim ElementID&, Arg1&, Arg2&
On Error Resume Next
With SeriesCollection(1)
    .Interior.Color = RGB(200, 200, 200)
    .DataLabels.Delete
    GetChartElement X, Y, ElementID, Arg1, Arg2
    If ElementID <> 3 Then Exit Sub
    With .Points(Arg2)
        .Interior.Color = vbRed
        .ApplyDataLabels
        .DataLabel.Text = Sheets("Data").Cells(1 + Arg2, 6)
    End With
End With
End Sub

Normalement fonctionne quel que soit le zoom ou la résolution.

 

[Magic_Doctor]

Bonjour sylvanu, job,

Merci pour cette courbe interactive en "bâtons" qui nous sort de la morosité des courbes classiques de ce type et qui servira à plus d'un, j'en suis convaincu.

Bonne fin de journée septentrionale.