Vous utilisez un navigateur obsolète. Il se peut que ce site ou d'autres sites Web ne s'affichent pas correctement. Vous devez le mettre à jour ou utiliser un navigateur alternatif.
Boostez vos compétences Excel avec notre communauté !
Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force.
Apprenez, échangez, progressez – et tout ça gratuitement !
👉 Inscrivez-vous maintenant !
Je souhaite faire apparaître sur mon graphe une zone partielle avec un effet loupe.
Voir l'exemple en PJ mais qui n'est réalisé qu'avec une image fixe. Je souhaite si on ajoute un essai ou si les valeurs dans un essai se corrigent que le zoom suive.
Et en bonus : idéalement sur une feuille graphe séparée 😉 .... et à défaut sur un graphique inclus dans une feuille de calcul.
Votre message étant ancien, je voudrai que vous me confirmiez si
vous êtes toujours intéressé par une solution.
Je viens d'en programmer une qui, si elle n'est pas entièrement satisfaisante,
a le mérite de faire.
C'est vrai qu'en cette période mon assiduité chute un peu 😉 mais la question qui n'est pas si ancienne reste toujours d'actualité donc je reste dans l'attente d'une solution satisfaisante.
La solution consiste bien sur à redéfinir les axes en les paramétrant selon l'effet loupe voulu.
Donc, une petite macro avec les mots horizontal et vertical, car les x et y sont inversés dans ton exemple.
Deux petits essais avec des paramètres différents d'expliqueront mieux mon propos puisqu'un bon dessin... comme dit le proverbe.
Comment ça inversé.......mais un graphe ça n'a pas de sens c'est comme un béret. 😀
Bon + sèrieusement, la solution que tu proposes est un graphe zoomé (ou loupé comme tu nommes ta macro) dans un graphe normal mais si je déplace mon graphique normal, le zoomé y suit pas 🙁 ......ou alors j'ai pas vu toute l'astuce.
Et en plus mon souhait est d'avoir le zoom "idéalement sur une feuille graphe séparée"
déplacer ton graphique principal et que l'autre suive, il faut le faire "à la main", j'en ai bien peur.
Si j'ai mis les graphique sur la même feuille c'est pour qu'on aie toujours devant soi le graphique principal pour mieux choisir les paramètres.
sinon, remplaces cette ligne
Je n'ai programmé que l'effet de loupe sur une partie du graphique.
L'image créée n'est pas dynamique (pas d'évolution si les données du graphique changent)
et elle s'inscrit à l'intérieur du graphique. Ainsi si les données changent, il faut relancer le programme.
En revanche, cela fonctionne sur un graphique incorporé dans une feuille de calcul ou
sur un graphique d'une feuille Graph.
MISE EN PLACE (un peu compliquée)
Etape 1
Copiez le code ci-dessous et collez le dans un module STANDARD
Code:
Dim myClasseChart As New clsEventChart
Sub Graphique_Zoom()
If TypeName(Selection) <> "ChartArea" Then
MsgBox "Veuillez sélectionner un graphique"
Exit Sub
End If
Set myClasseChart.ChartClass = ActiveChart
End Sub
Etape 2
1) Créez un module de CLASSE
2) Appuyez sur F4
3) Dans la fenêtre de propriétés allez sur la propriété (Name).
La valeur par défaut doit être "Classe1". Changez cette valeur par "clsEventChart"
4) Copiez le code ci-dessous et collez le dans fenêtre de code du module de classe
Code:
Public WithEvents ChartClass As Chart
Const ZOOM As Double = 4
Dim myX As Long
Dim myY As Long
Private Sub ChartClass_MouseDown(ByVal Button As Long, _
ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
If Shift <> 1 Or Button <> 1 Then Exit Sub
myX = x
myY = y
Call ZoomPartie
End Sub
Public Property Get Abcisse() As Long
Abcisse = myX
End Property
Public Property Get Ordonnee() As Long
Ordonnee = myY
End Property
Private Sub ZoomPartie()
Dim TypeSheet As Object
Dim OldSheet As Worksheet
Dim S As Worksheet
Dim C As Chart
Dim CO As ChartObject
Dim colPlage&
Dim rowPlage&
Dim R As Range
Dim SH As Shape
Dim NomGraph$
On Error GoTo Erreur
Application.ScreenUpdating = False
If ActiveSheet.Type = xlWorksheet Then _
Set OldSheet = ActiveSheet
Set C = ActiveChart
NomGraph$ = C.Parent.Name
On Error Resume Next
Set SH = ActiveChart.Shapes(NomGraph$)
On Error GoTo 0
On Error GoTo Erreur
If Not SH Is Nothing Then SH.Delete
C.ChartArea.Copy
Set S = Sheets.Add
S.Cells.RowHeight = 26.92
S.Cells.ColumnWidth = 4.35
S.Paste
Set CO = S.ChartObjects(1)
CO.Height = CO.Height * ZOOM
CO.Width = CO.Width * ZOOM
colPlage& = CLng(myX / 35.2 * ZOOM)
rowPlage& = CLng(myY / 35.2 * ZOOM)
S.[a1].Select
If colPlage& < 2 Then colPlage& = 3
If rowPlage& < 2 Then rowPlage& = 3
If colPlage& > 255 Then colPlage& = 254
If rowPlage& > 65535 Then rowPlage& = 65534
Set R = S.Range(S.Cells(rowPlage& - 2, colPlage& - 2), _
S.Cells(rowPlage& + 2, colPlage& + 2))
R.CopyPicture
S.Shapes(1).Delete
S.Paste
Set SH = S.Shapes(1)
SH.Name = NomGraph$
Selection.ShapeRange.Height = 90
Selection.ShapeRange.Width = 90
SH.Copy
Application.DisplayAlerts = False
S.Delete
If ActiveSheet.Type = xlWorksheet Then
OldSheet.Select
ActiveSheet.ChartObjects(NomGraph$).Activate
End If
ActiveChart.Paste
Set SH = ActiveChart.Shapes(NomGraph$)
SH.IncrementTop myY / 2.5
SH.IncrementLeft myX / 1.35
SH.Placement = xlMoveAndSize
With Selection.ShapeRange.Line
.DashStyle = msoLineSolid
.ForeColor.SchemeColor = 10
End With
Erreur:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
If Err <> 0 Then
MsgBox "Erreur " & Err.Number & vbCrLf & Err.Description
End If
End Sub
La mise en place est terminée.
FONCTIONNEMENT
1) Sélectionnez un graphique quelconque (créez en si il n'y en pas).
Faites attention de bien sélectionner le graphique et non une zone du graphique (Chartarea, Série, …).
Le mieux est de cliquer dans un des coins du graphique.
2) Lancez la macro "Graphique_Zoom". Normalement rien ne se passe.
3) Si vous faites touche Majuscule MAINTENUE et cliquez gauche à l'intérieur du graphique sélectionné
une forme apparaîtra avec effet de zoom. J'ai eu des soucis occasionnés par les différentes
unités de mesure (twips, inches, points) aussi ai-je réglé cela au pifomètre !!!
Si bien que l'image grossie ne correspond pas exactement à l'endroit où on clique.
Si le résultat présente un trop grand décalage, il suffit de refaire l'opération (SHIFT maintenue, clic gauche)
afin de peaufiner ; la forme précédente est systématiquement détruite à chaque renouvellement.
En espérant avoir tout dit, je vous souhaite un bon test.
Ca marche même sur le Mac, avec un petit décalage, il faut cliquer 2 cm ) droite et 1 cm plus bas que la zone désirée, je vais essayer de trouver où reparamètrer ça, mais je ne refuse pas un coup de main...😱, la majorité des instructions me sont encore inconnues, ou sibyllines.
En tout cas, ça va m'être bien utile, comme à Risleure qui le demandait.
J'aurai bien aimé tester cette loupe, mais j'ai le message d'erreur suivant :
Erreur de compilation:
Membre de métode ou de données introuvable
et le mot .ChartClass est surligné.
Sub Graphique_Zoom()
If TypeName(Selection) <> "ChartArea" Then
MsgBox "Veuillez sélectionner un graphique"
Exit Sub
End If
Set myClasseChart.ChartClass = ActiveChart
End Sub
Je pense avoir bien suivi les instructions. Aurais-je omis de faire ou déclarer quelque chose dans ces macros SVP ?
OK c'est bon, j'avais effectivement oublié un bout de code.
Maintenant j'ai bien une loupe (une zone carrée quadrillée) mais aucun grossissement. Mystère.
Effectivement là c'est génial. Je vais essayer sur d'autres graphiques.
J'ai vu que l'on pouvait aussi la redimensionner alors que jusqu'à maintenant je n'avais pas d'action à part la déplacer.
- Navigue sans publicité - Accède à Cléa, notre assistante IA experte Excel... et pas que... - Profite de fonctionnalités exclusives Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel. Je deviens Supporter XLD
