sub TraceCourbes(....)
....
' ----- dans l'appli.
For Graphe = 1 To NbGraphes
Select Case Graphe
Case 1
Decal = 0
Efface = True
Case 2
Decal = DecEntGraphPat
Efface = False
End Select
Call TraceNuagePoints(Workbooks(NomAppli), NLignes, Decal, Efface)
Next Graphe
' ----- dans l'autre appli.
For Graphe = 1 To NbGraphes
Select Case Graphe
Case 1
Decal = 0
Efface = True
Case 2
Decal = DecEntGraphPat
Efface = False
End Select
Call TraceNuagePoints(Workbooks(NomAutreAppli), NLignes, Decal, Efface)
Next Graphe
End Sub
' ============== Trace le nuage de points
Sub TraceNuagePoints(WkBook As Workbook, NbLignes As Integer, Dec As Integer, Effacer As Boolean)
Dim PlageGraphe As Range
Dim PenteKi As String
Dim OrdOrVd As String
' ----- Définition des plages des séries du graphe dans la feuille mémoire
With WkBook.Worksheets(RMmemoire.Name)
Select Case Graphe
Case 1
Set PlageGraphe = Union(.Range(.Range("EntSurAire"), .Range("EntSurAire").Offset(NbLignes, 0)), .Range(.Range("Comp1SurAire"), .Range("Comp1SurAire").Offset(NbLignes, 0)))
Case 2
Set PlageGraphe = Union(.Range(.Range("EntSurAire"), .Range("EntSurAire").Offset(NbLignes, 0)), .Range(.Range("Comp2SurAire"), .Range("Comp2SurAire").Offset(NbLignes, 0)))
End Select
End With
[COLOR="Red"]With WkBook.Worksheets(RMpatlak.Name)
' ----- Effacement des graphes et des étiquettes précédentes sur la feuille RMpatlak
If Effacer = True Then .ChartObjects.Delete ' On efface seulement si premier graphe
' ----- Création du graphe
Charts.Add
With ActiveChart
.ChartType = xlXYScatter
.SetSourceData Source:=PlageGraphe, PlotBy:=xlColumns
.HasLegend = False
.HasTitle = True
.Location Where:=xlLocationAsObject, Name:=RMpatlak.Name [/COLOR] ' Met le graphe sur la feuille
End With
' ----- Dimensions, décalage et couleur du cadre -------------------
With ActiveSheet.ChartObjects(Graphe)
.Left = 20
.Top = 60 + Dec
.Width = 390
.....