Salut
Vraiment une belle idée que cette petite fonction. Comme j'ai trouvé ça très chouette, j'y suis allé voir de plus près, et je l'ai un peu compactée (bon, j'ai changé le nom des variables, simplement pour m'aider à m'y retrouver). La procédure ShapeDelete est devenue inutile.
J'en ai aussi profité pour modifier 2 petites choses :
-Maintenant on peut indiquer une plage en ligne ou en colonne sans que ça renvoie d'erreur.
-les couleurs sont passées par leur numéro d'index dans la palette - ça restreint un peu le choix mais c'est plus simple pour s'y retrouver qu'avec une valeur RGB
Function LineChart(Points As Range, ByVal Color%)
'la couleur est une valeur de palette (de 1 à 56)
'Une belle fonction de Rob Van Gelder un peu modifiée par Ti
Const KMarge = 2
Dim Ref As Range, ShRg(), Bcle&
Dim Min#, Max#, Pts, Cnt&
On Error Resume Next
Set Ref = Application.Caller
With Points
If .Rows.Count > 1 And .Columns.Count > 1 Then
LineChart = CVErr(xlErrValue): Exit Function
End If
Pts = .Value: Cnt = .Count
If .Columns.Count > 1 Then Pts = WorksheetFunction.Transpose(Pts)
End With
Min = WorksheetFunction.Min(Pts)
Max = WorksheetFunction.Max(Pts)
ReDim ShRg(0 To Cnt - 2)
With Ref
.Worksheet.Shapes(.Address).Delete
For Bcle = 0 To Cnt - 2
With .Worksheet.Shapes.AddLine( _
KMarge + .Left + (Bcle * (.Width - (KMarge * 2)) / (Cnt - 1)), _
KMarge + .Top + (Max - Pts(Bcle + 1, 1)) * (.Height - (KMarge * 2)) / (Max - Min), _
KMarge + .Left + ((Bcle + 1) * (.Width - (KMarge * 2)) / (Cnt - 1)), _
KMarge + .Top + (Max - Pts(Bcle + 2, 1)) * (.Height - (KMarge * 2)) / (Max - Min))
ShRg(Bcle) = .Name
End With
Next Bcle
With .Worksheet.Shapes.Range(ShRg)
.Group
.Line.ForeColor.SchemeColor = Abs(Color)
.Name = Ref.Address
End With
End With
LineChart = ''
End Function