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