Comment déplacer les points d'un graphique à la souris (VBA)
Sous les anciennes versions d'Excel, il était possible de déplacer un point d'un graphique xy à la souris, les valeurs de la source étaient modifiées en conséquence.
Le progrès aidant, cette fonctionnalité pourtant bien pratique a été supprimée.
Les quelques lignes de code présentées ci-après permettent de contourner le problème en utilisant la gestion d'évenements de graphique, au prix d'un certain manque de fluidité...
On crée un nouveau module de classe "graf_modifiable" qui va définir le comportement de notre graphique (qu'on appelle "monGraf").
Au moment où on sélectionne un point du graphique, il faut mémoriser les cellules liées au point sélectionné (cellx et celly) et les valeurs (xinit et yinit) contenues dans ces cellules.
On réalise ces opérations grace à un sub monGraf_Select qui se déclenchera dès sélection du graphique, et qui va extraire les données de la formule de la source de la série :
Private Sub monGraf_Select(ByVal ElementID As Long, ByVal Arg1 As Long, ByVal Arg2 As Long)
Dim frmul As String
If ElementID = xlSeries And Arg2 > 0 Then 'le point Arg2 de la série Arg1 est sélectionné
'frmul est la formule de la série
frmul = monGraf.SeriesCollection(Arg1).Formula
frmul = Right(frmul, Len(frmul) - InStr(frmul, ","))
Set cellx = Range(Left(frmul, InStr(frmul, ",") - 1))
Set cellx = cellx.Cells(Arg2) 'cellx est la cellule contenant l'abscisse du point sélectionné
xinit = cellx.Value 'on enregistre la valeur de l'abscisse avant déplacement du point
frmul = Right(frmul, Len(frmul) - InStr(frmul, ","))
Set celly = Range(Left(frmul, InStr(frmul, ",") - 1))
Set celly = celly.Cells(Arg2) 'celly est la cellule contenant l'ordonnée du point sélectionné
yinit = celly.Value 'on enregistre la valeur de l'ordonnée avant déplacement du point
selected = True 'on enregistre le fait qu'un point est sélectionné
End If
End Sub
Il nous faut aussi connaitre la position du point en pixels avant déplacement (xdernclick, ydernclick). On va l'enregitrer au moment ou l'on fait un clic de souris grace à un Sub monGraf_MouseDown.
On en profite pour calculer l'"échelle" du graphique, le rapport entre les coordonnées en pixel et les coordonnées de la source de données :
Private Sub monGraf_MouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
If selected = True Then selected = False 'si on clique alors qu'un point est sélectionné, on fige sa position
'calcul de la relation entre les valeurs abscisses-ordonnées et le nombre de pixels
echx = (monGraf.Axes(1).MaximumScale - monGraf.Axes(1).MinimumScale) / monGraf.PlotArea.InsideWidth * GetPixelsToPointsRatioX()
echy = -(monGraf.Axes(2).MaximumScale - monGraf.Axes(2).MinimumScale) / monGraf.PlotArea.InsideHeight * GetPixelsToPointsRatioY()
'on enregistre les coordonnées du point cliqué
xdernclick = x
ydernclick = y
End Sub
Il nous reste à déplacer le point quand la souris se déplace et qu'un point a été sélectionné.
On utilise le sub Sub monGraf_MouseMove qui s'assure qu'un point du graphique a bien été sélectionné et qui modifie les cellules sources en fonction du déplacement de la souris :
Private Sub monGraf_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
'quand un point est sélectionné, on modifie les cellules sources pour le déplacer avec la souris
If selected And Selection.Name Like "S*P*" Then
cellx.Value = xinit + echx * (x - xdernclick)
celly.Value = yinit + echy * (y - ydernclick)
End If
End Sub
Avant de tester, ne pas oublier de déclarer et d'initialiser toutes les variables en ajoutant en tête du module :
Option Explicit
Public WithEvents monGraf As Chart
Public echx As Double
Public echy As Double
Public xinit As Double
Public yinit As Double
Public xdernclick As Double
Public ydernclick As Double
Public selected As Boolean
Public cellx As Object
Public celly As Object
Sub monGraf_initialise()
echx = 1
echy = 1
Set cellx = Nothing
Set celly = Nothing
selected = False
xinit = 0
yinit = 0
xdernclick = 0
ydernclick = 0
End Sub
Pour rendre un graphique modifiable, il suffit maintenant de créer un nouvel objet "graf_modifiable".
Si notre graphique est le premier graphique de la page "graf_test" :
Dim cl_gr As graf_modifiable
Sub zaza()
Set cl_gr = New graf_modifiable
Set cl_gr.monGraf = Worksheets("graf_test").ChartObjects(1).Chart
End Sub
Il suffit de lancer zaza pour rendre le graphique modifiable.
On pourra utilement le rendre modifiable dès l'ouverture du fichier en utilisant Workbook_Open :
Dim cl_gr As graf_modifiable
Private Sub Workbook_Open()
Set cl_gr = New graf_modifiable
Set cl_gr.monGraf = Worksheets("graf_test").ChartObjects(1).Chart
End Sub
On peut aussi rendre plusieurs graphiques modifiables à la souris :
Dim cl_gr As graf_modifiable
Dim cl_gr2 As graf_modifiable
Private Sub Workbook_Open()
Set cl_gr = New graf_modifiable
Set cl_gr.monGraf = Worksheets("graf_test").ChartObjects(1).Chart
Set cl_gr2 = New graf_modifiable
Set cl_gr2.monGraf = Worksheets("graf_test").ChartObjects(2).Chart
End Sub
Le texte complet du module de classe :
Option Explicit
Public WithEvents monGraf As Chart
Public echx As Double
Public echy As Double
Public xinit As Double
Public yinit As Double
Public xdernclick As Double
Public ydernclick As Double
Public selected As Boolean
Public cellx As Object
Public celly As Object
Sub monGraf_initialise()
echx = 1
echy = 1
Set cellx = Nothing
Set celly = Nothing
selected = False
xinit = 0
yinit = 0
xdernclick = 0
ydernclick = 0
End Sub
Private Sub monGraf_Select(ByVal ElementID As Long, ByVal Arg1 As Long, ByVal Arg2 As Long)
Dim frmul As String
If ElementID = xlSeries And Arg2 > 0 Then 'le point Arg2 de la série Arg1 est sélectionné
'frmul est la formule de la série
frmul = monGraf.SeriesCollection(Arg1).Formula
frmul = Right(frmul, Len(frmul) - InStr(frmul, ","))
Set cellx = Range(Left(frmul, InStr(frmul, ",") - 1))
Set cellx = cellx.Cells(Arg2) 'cellx est la cellule contenant l'abscisse du point sélectionné
xinit = cellx.Value 'on enregistre la valeur de l'abscisse avant déplacement du point
frmul = Right(frmul, Len(frmul) - InStr(frmul, ","))
Set celly = Range(Left(frmul, InStr(frmul, ",") - 1))
Set celly = celly.Cells(Arg2) 'celly est la cellule contenant l'ordonnée du point sélectionné
yinit = celly.Value 'on enregistre la valeur de l'ordonnée avant déplacement du point
selected = True 'on enregistre le fait qu'un point est sélectionné
End If
End Sub
Private Sub monGraf_MouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
If selected = True Then selected = False 'si on clique alors qu'un point est sélectionné, on fige sa position
'calcul de la relation entre les valeurs abscisses-ordonnées et le nombre de pixels
echx = (monGraf.Axes(1).MaximumScale - monGraf.Axes(1).MinimumScale) / monGraf.PlotArea.InsideWidth * GetPixelsToPointsRatioX()
echy = -(monGraf.Axes(2).MaximumScale - monGraf.Axes(2).MinimumScale) / monGraf.PlotArea.InsideHeight * GetPixelsToPointsRatioY()
'on enregistre les coordonnées du point cliqué
xdernclick = x
ydernclick = y
End Sub
Private Sub monGraf_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
'quand un point est sélectionné, on modifie les cellules sources pour le déplacer avec la souris
If selected And Selection.Name Like "S*P*" Then
cellx.Value = xinit + echx * (x - xdernclick)
celly.Value = yinit + echy * (y - ydernclick)
End If
End Sub
Private Sub monGraf_MouseUp(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
If selected = False And Selection.Name Like "S*P*" Then
monGraf.ChartArea.Select
End If
End Sub