Zoom à la souris sur un graphique excel
5/5 (8 avis)
Vue 11 510 fois - Téléchargée 953 fois
Description
Depuis longtemps, je galère pour zoomer mes graph sous excel alors que certain logiciels font
çà de manière ultra simple (à la souris)
Après de nombreuse recherches sur internet, pour trouver un gentil programmeur qui aurais fais
une macro qui va bien,je n'ai rien trouvé de concluant.
Je me suis donc décidé à me mettre au VBA pour implémenter ce zoom.
Après de long mois de travail (je débutais!!) et de nombreuse approches
et problématiques(dont je vous passerais les détail),
j'ai le plaisir de vous faire partager mon code:
Cet outil de Zoom pour Excel permet:
- de faire un zoom à la souris en traçant un rectangle en cliquant sur "F2"
- de déplacer la courbe en bougeant la souris avec Ctrl appuyé
- faire un retour aux échelles auto en faisant "Ctrl a"
- faire un retour aux échelles auto par clic droit (seulement sur XL2000)
J'utilise les événement graphiques dans un module de classe
pour l'utiliser, copiez la première partie du code dans Thisworkbook
et la seconde dans un module de classe appelé classe_zoom
Je l'ai pas mal testé sur XL2000 mais quasiment pas sur 2007 et pas du tout sur 2010
Je n'arrive pas à faire fonctionner le menu contextuel sur 2007, j'ai l'impression que ce n'est pas
possible, mais si quelqu'un à la réponse, je suis preneur.
De même j'ai un léger effet sapin de noël sur le déplacement de courbe sous XL2000.
J'avais aussi pensé à en faire une macro complémentaire afin de pouvoir l'utiliser sur n'importe
quel fichier. Mais je ne sais pas encore comment faire et je ne me suis pas encore penché sur la
question.
Je pense que ce seras pour un prochaine évolution.
Je suis à votre écoute pour toutes correction de bug éventuel ou pour des amélioration
çà de manière ultra simple (à la souris)
Après de nombreuse recherches sur internet, pour trouver un gentil programmeur qui aurais fais
une macro qui va bien,je n'ai rien trouvé de concluant.
Je me suis donc décidé à me mettre au VBA pour implémenter ce zoom.
Après de long mois de travail (je débutais!!) et de nombreuse approches
et problématiques(dont je vous passerais les détail),
j'ai le plaisir de vous faire partager mon code:
Cet outil de Zoom pour Excel permet:
- de faire un zoom à la souris en traçant un rectangle en cliquant sur "F2"
- de déplacer la courbe en bougeant la souris avec Ctrl appuyé
- faire un retour aux échelles auto en faisant "Ctrl a"
- faire un retour aux échelles auto par clic droit (seulement sur XL2000)
J'utilise les événement graphiques dans un module de classe
pour l'utiliser, copiez la première partie du code dans Thisworkbook
et la seconde dans un module de classe appelé classe_zoom
Source / Exemple :
'Dans Thisworkbook:
Dim myclassmodule As New classe_zoom
Private Sub Workbook_Open()
Call charge_class
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Call charge_class
End Sub
Private Sub charge_class()
Dim graph As String
'on cherche si il y a un graph , on passe à l'instruction suivante si il n'y en a pas
On Error Resume Next
graph = ActiveChart.Name
' on attribut le lancement du zoom à F2 si il y a un graph sur la feuille
If graph <> Empty Then
'on déclare le module de classe pour la feuille active
Set myclassmodule.mychartclass = ActiveChart
Application.OnKey "{F2}", "ThisWorkbook.zoom"
Application.OnKey "^a", "thisworkbook.echelle_auto"
ActiveSheet.Unprotect
Else
Application.OnKey "{F2}"
Application.OnKey "^a"
End If
'ajout du menu retour echelle auto
Application.CommandBars("plot area").Reset
With Application.CommandBars("plot area").Controls.Add(msoControlButton, Before:=1, temporary:=True)
.Caption = "Retour echelle auto" 'le nom de la commande
.BeginGroup = True 'ligne facultative si elle est précisée alors
.OnAction = "thisworkbook.echelle_auto" ' la macro 1 est lancé
End With
End Sub
'on met cette macro dans le thisworkbook afin d'avoir tous nos outils de zoom
'dans un seul module de classe classe_zoom (pas d'ajour d'autre module)
Private Sub zoom()
Call myclassmodule.zoom_souris
End Sub
Public Sub echelle_auto()
Call myclassmodule.retour_echelle_auto
End Sub
'Dans un module de classe nommé classe_zoom
Option Explicit
Public WithEvents mychartclass As Chart
Dim X0 As Long, Y0 As Long
Dim top_rect As Long, left_rect As Long
Dim top_graph As Single, left_graph As Single
Dim timer As Long, nb_shape As Integer
Dim ax As Axis
'déclaration des tableaux pour les collections
Dim dimension_graph(2) As Long, dimension_rect(2) As Long
Dim axe_min(2, 2) As Single, axe_max(2, 2) As Single
Dim axe_new_echelle(2, 2) As Single, axe_echelle(2, 2) As Single, ratio_echelle(2, 2) As Single
Dim unite_princ As Variant
Dim axe_max_new(2, 2) As Single, axe_min_new(2, 2) As Single
Dim delta_souris(2) As Long
Dim i As Long, j As Long
Const sensibilite = 5
Private Sub mychartclass_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
Application.StatusBar = "x=" & x & " " & "y=" & y
If Shift = 0 Then
'Quand Ctrl n'est pas enfoncé, on récupére les coordonnées origine et les axes
X0 = x
Y0 = y
For Each ax In ActiveChart.Axes
With ax
i = .Type 'type d'axe x ou y
j = .AxisGroup 'groupe d'axe principal ou secondaire
axe_min(i, j) = .MinimumScale
axe_max(i, j) = .MaximumScale
End With
Next
Application.Cursor = xlNormal
End If
If Shift = 2 Then 'si Ctrl est appuyé
If Button = 0 Then 'pour ne pas activer la fonction si on clique le bouton de la souris
ActiveChart.Deselect 'On enleve toute selection pour faire plus propre
Application.Cursor = 1
Application.ScreenUpdating = False
'on calcule le mouvement de la souris en X et en Y
delta_souris(1) = X0 - x
delta_souris(2) = y - Y0 'sur Y on inverse car le zéro de la souris est en haut du graph
Application.StatusBar = "Dx=" & delta_souris(1) & " " & "Dy=" & delta_souris(2)
For Each ax In ActiveChart.Axes
With ax
i = .Type 'type d'axe x ou y
j = .AxisGroup 'groupe d'axe principal ou secondaire
unite_princ = .MajorUnit
'on ajoute aux valeur origine des axes, la variation de la souris divisé
'par la a sensibilité et pondérée de l'unité principale de l'axe
axe_min_new(i, j) = axe_min(i, j) + (unite_princ * delta_souris(i) / sensibilite)
axe_max_new(i, j) = axe_max(i, j) + (unite_princ * delta_souris(i) / sensibilite)
'on entre les nouvelles echelles arrondi sur la base de l'unité principale
.MaximumScale = Round((axe_max_new(i, j) / unite_princ), 0) * unite_princ
.MinimumScale = Round((axe_min_new(i, j) / unite_princ), 0) * unite_princ
.CrossesAt = .MinimumScale
End With
Next
End If 'if button
End If ' if shift=2
End Sub
Function zoom_souris()
'on trace le rectangle
ActiveChart.Select 'on selectionne la graph pour ne pas planter sous XL2007
Application.CommandBars("Drawing").Controls("Rectangle").Execute
modif_echelle
End Function
Function modif_echelle()
'on attend que le rectangle soit tracé en comptant les shapes sur la feuille
'peut être amélioré si on arrive a créer directement le rectangle nommé fenetre_zoom,
'on testerait alors sur l'existence de celui-ci
nb_shape = ActiveChart.Shapes.Count
timer = 0
Do While ActiveChart.Shapes.Count <= nb_shape
DoEvents 'Pour ne pas bloquer les actions sur l'userform pendant le tracé du graphe on utilise fonction DoEvents
'on fait une petite tempo afin de ne pas être bloqué dans la boucle
If timer = 100000 Then
MsgBox "zoom annulé"
Exit Function
End If
timer = timer + 1
Loop
Application.ScreenUpdating = False
'Selection.ShapeRange.Fill.Visible = msoFalse
Selection.Name = "fenetre_zoom"
'mesure du rectangle
With ActiveChart.Shapes("fenetre_zoom")
top_rect = .Top
left_rect = .Left
dimension_rect(1) = .Width 'Largeur
dimension_rect(2) = .Height 'hauteur
.Delete 'on efface le rectangle
End With
'mesure du cadre graphique
With ActiveChart.PlotArea
top_graph = .InsideTop
left_graph = .InsideLeft
dimension_graph(1) = .InsideWidth 'Largeur
dimension_graph(2) = .InsideHeight 'hauteur
End With
For Each ax In ActiveChart.Axes
With ax
i = .Type 'type d'axe x ou y
j = .AxisGroup 'groupe d'axe principal ou secondaire
axe_min(i, j) = .MinimumScale
axe_max(i, j) = .MaximumScale
axe_echelle(i, j) = axe_max(i, j) - axe_min(i, j)
'On calcule le ratio entre les échelle actuelle et les dimensions du graph
ratio_echelle(i, j) = (axe_echelle(i, j) / dimension_graph(i))
'On calcule donc la nouvelle échelle a partir du rectangle dessiné (Largeur en X et hauteur en Y)
axe_new_echelle(i, j) = dimension_rect(i) * ratio_echelle(i, j)
'On calcule l'échelle des X
'ici on part de la gauche on commence donc par Xmin
axe_min_new(1, 1) = axe_min(1, 1) + ((left_rect - left_graph) * ratio_echelle(1, 1))
axe_max_new(1, 1) = axe_min_new(1, 1) + axe_new_echelle(1, 1)
'on modifie les echelles Y principale et secondaire
'On soustrait la position du rectangle(rationnée et recalé) a l'echelle max
axe_max_new(2, j) = axe_max(2, j) - ((top_rect - top_graph) * ratio_echelle(2, j))
axe_min_new(2, j) = axe_max_new(2, j) - axe_new_echelle(2, j)
'On détermine le format de l'axe pour arrondir au nombre de chiffres
'de l'unité principale (cela évite d'avoir 12 chiffres après la virgule)
unite_princ = .MajorUnit
'on entre les nouvelles echelles arrondi sur la base de l'unité principale
.MinimumScale = Round((axe_min_new(i, j) / unite_princ), 0) * unite_princ
.MaximumScale = Round((axe_max_new(i, j) / unite_princ), 0) * unite_princ
.MajorUnitIsAuto = True 'on active l'unité principale pour avoir un recalcul
.MajorUnitIsAuto = False 'on la désactive pour ne pas avoir de recalcul quand on glisse la courbe
End With
Next
Application.ScreenUpdating = True
End Function
Function retour_echelle_auto()
Application.ScreenUpdating = False
For Each ax In ActiveChart.Axes
With ax
.MinimumScaleIsAuto = True
.MaximumScaleIsAuto = True
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.MinorUnitIsAuto = False
.MajorUnitIsAuto = False
.CrossesAt = 0
End With
Next
Application.ScreenUpdating = True
End Function
Conclusion :
Je l'ai pas mal testé sur XL2000 mais quasiment pas sur 2007 et pas du tout sur 2010
Je n'arrive pas à faire fonctionner le menu contextuel sur 2007, j'ai l'impression que ce n'est pas
possible, mais si quelqu'un à la réponse, je suis preneur.
De même j'ai un léger effet sapin de noël sur le déplacement de courbe sous XL2000.
J'avais aussi pensé à en faire une macro complémentaire afin de pouvoir l'utiliser sur n'importe
quel fichier. Mais je ne sais pas encore comment faire et je ne me suis pas encore penché sur la
question.
Je pense que ce seras pour un prochaine évolution.
Je suis à votre écoute pour toutes correction de bug éventuel ou pour des amélioration
Codes Sources
A voir également
- Zoom à la souris sur un graphique excel
- Zoom infini - Forum Flash
- Dessin souris - Forum C# / .NET
- Interface graphique c++ ✓ - Forum C++ & C++ .NET
- Arctan sur excel ✓ - Forum Visual Basic 6
- Calcul sur excel de l'inverse tangente en grade - Forum VBA Office (Excel, Word ...)
4 nov. 2016 à 15:01
Modifié par Ecirbaf11 le 16/05/2014 à 16:29
Merci pour cet utilitaire vraiment pratique... J'arrive pas à comprendre pourquoi il ne l'implante pas directement sur EXCEL ou au moins sur 1 add-ind en option ?
Je désire installer cet utilitaire de façon général (utilisable sur tous les fichiers Excel), quelqu'un aurait-il la solution ?
Merci d'avance
23 juil. 2011 à 08:43
22 juil. 2011 à 23:04
Pour le message zoom annulé, j'avais vu que le timer était plus rapide sous 2007, il faut l'augmenter dans la Function modif_echelle()
Sinon, je suis preneur de toutes vos bonnes idées d'optimisation.
Merci pour vos commentaire,
@+
22 juil. 2011 à 18:31
Très bon travail(surtout pour un débutant, chapeau!), il y a plein de trucs intéressants dans ton code.
Il peut bien sûr être amélioré, en particulier pour le déplacement des courbes (la modification de la sensibilité semble peu efficace), et le déclenchement du zoom (message "zoom annulé" apparaissant fréquemment).
Il serait bon aussi que le code fonctionne au moins pour la version Excel 2007, la version 2000 étant quand même assez dépassée maintenant..., et pour les graphiques intégrés aux feuilles classiques.
Je vais l'étudier et voir ce que je peux t'apporter.
Cdt
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.