Echelle absisse = échelle ordonnée!!!

[alex_all]

Bonjour!

J'ai un graphique représentant une vallée et j'aimerais que l'échelle des x correspondent à l'échelle des y (les 2 unités sont des mètres). Il est possible d'agrandir le graphique manuellement en tirant dessus de façon à faire correspondre les 2 axes approximativement. Mais n'est-il pas possible de cocher une fonction qui le fasse automatiquement?

Merci d'avance.

 

[Dranreb]

Re : Echelle absisse = échelle ordonnée!!!

Bonjour
J'ai ça:

Sub GraphIsoEchelles(Optional ByVal Graph As Chart = Nothing, _
   Optional ByVal XGMin As Double = 0, Optional ByVal XDMin As Double = 0, _
   Optional ByVal YHMin As Double = 0, Optional ByVal YBMin As Double = 0)
Dim dX As Double, dY As Double, Largeur As Double, Hauteur As Double, Ech As Double, _
   ZTrac As PlotArea, ObjG As ChartObject, _
   XMil As Double, YMil As Double, _
   XMrg As Double, YMrg As Double, N As Long
If Graph Is Nothing Then Set Graph = ActiveChart
On Error Resume Next
With Graph
   Set ZTrac = .PlotArea: Set ObjG = .Parent: If Err Then Set ObjG = Nothing
   End With
On Error GoTo 0
With Graph.Axes(xlCategory): dX = .MaximumScale - .MinimumScale: End With
With Graph.Axes(xlValue): dY = .MaximumScale - .MinimumScale: End With
If ObjG Is Nothing Then
   Graph.SizeWithWindow = True
   ZTrac.Left = XGMin: ZTrac.Width = Graph.ChartArea.Width - XDMin - XGMin
   ZTrac.Top = YHMin: ZTrac.Height = Graph.ChartArea.Height - YHMin - YBMin
   End If
For N = 1 To 4
   Largeur = ZTrac.InsideWidth
   Hauteur = ZTrac.InsideHeight
   If ObjG Is Nothing Then
      Ech = Min(Largeur / dX, Hauteur / dY)
      ZTrac.Width = ZTrac.Width - Largeur + dX * Ech
      ZTrac.Height = ZTrac.Height - Hauteur + dY * Ech
   Else
      Ech = Sqr((Largeur * Hauteur) / (dX * dY))
      ObjG.Width = ObjG.Width - Largeur + dX * Ech
      ObjG.Height = ObjG.Height - Hauteur + dY * Ech
      End If
   Next N
End Sub
'

Property Get NbPtsAxe(Graph As Chart, AxType As XlAxisType) As Double
With Graph.PlotArea
   Select Case AxType
      Case xlCategory: NbPtsAxe = .InsideWidth
      Case xlValue: NbPtsAxe = .InsideHeight
      Case xlSeriesAxis: NbPtsAxe = 1
      End Select
   End With
End Property
Property Let NbPtsAxe(Graph As Chart, AxType As XlAxisType, ByVal NbPts As Double)
Dim ZTrac As PlotArea, ZGrap As ChartObject, Incorporé As Boolean
On Error Resume Next
With Graph: Set ZTrac = .PlotArea: Set ZGrap = .Parent: End With
Incorporé = Err = 0
On Error GoTo 0
Select Case AxType
   Case xlCategory:
      If Incorporé Then
         ZTrac.Left = 0: ZTrac.Width = ZGrap.Width
         ZGrap.Width = ZGrap.Width - ZTrac.InsideWidth + NbPts
         End If
      ZTrac.Width = ZTrac.Width - ZTrac.InsideWidth + NbPts
      If ZTrac.InsideWidth <> NbPts Then MsgBarreÉtat ZTrac.InsideWidth _
          & " points de large définis au lieu des " & NbPts & " demandés."
   Case xlValue:
      If Incorporé Then
         ZTrac.Top = 0: ZTrac.Height = ZGrap.Height
         ZGrap.Height = ZGrap.Height - ZTrac.InsideHeight + NbPts
         End If
      ZTrac.Height = ZTrac.Height - ZTrac.InsideHeight + NbPts
      If ZTrac.InsideHeight <> NbPts Then MsgBarreÉtat ZTrac.InsideHeight _
         & " points de haut définis au lieu des " & NbPts & " demandés."
   Case xlSeriesAxis: MsgBox "?", vbCritical: Stop
   End Select
End Property

Remarque: c'est assez vieux, je regarderai peut être un jour si on ne peut pas faire plus simple.
À+