Je cherche une fonction perso qui trace un graphique dans une cell

Le
Trirème
Bonjour à tous,
Je recherche une fonction perso dont l'objet est de tracer un
micro-graphique dans une cellule grâce à l'outil de dessin (forme
automatique, ligne, forme libre). Les arguments passés à la fonction sont le
range des cellules à prendre en compte et la couleur du tracé.
Je précise que j'ai vu cette fonction il y a quelques temps, je ne sais plus
ni où ni de qui, et de toute façon, je l'ai perdue.
Si quelqu'un pouvait pallier mon alzheimer naissant, je l'en remercierai.

Cordialement,
Trirème
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses Page 1 / 2
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
AV
Le #4584311
Je recherche une fonction perso dont l'objet est de tracer un
micro-graphique dans une cellule grâce à l'outil de dessin


Function LineChart(Points As Range, ByVal Color%) 'Rob Van Gelder
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 = Application.Transpose(Pts)
End With
leMin = Application.Min(Pts)
leMax = Application.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 + (leMax - Pts(Bcle + 1, 1)) * (.Height - (KMarge * 2)) / (leMax -
leMin), _
KMarge + .Left + ((Bcle + 1) * (.Width - (KMarge * 2)) / (Cnt - 1)), _
KMarge + .Top + (leMax - Pts(Bcle + 2, 1)) * (.Height - (KMarge * 2)) / (leMax -
leMin))
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


Utilisation dans une cellule:
=LineChart(LaPlage;IndexCouleur)

Exemple là :
http://cjoint.com/?gspRLyujgC

AV

Trirème
Le #4584271
Merci Alain,
C'est pile poil ce que j'avais perdu.
Maintenant c'est classé et référencé.

Bonne journée et merci encore. tu viens de faire un heureux.
Cordialement,
Trirème


Je recherche une fonction perso dont l'objet est de tracer un
micro-graphique dans une cellule grâce à l'outil de dessin


Function LineChart(Points As Range, ByVal Color%) 'Rob Van Gelder
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 = Application.Transpose(Pts)
End With
leMin = Application.Min(Pts)
leMax = Application.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 + (leMax - Pts(Bcle + 1, 1)) * (.Height - (KMarge * 2)) / (leMax -
leMin), _
KMarge + .Left + ((Bcle + 1) * (.Width - (KMarge * 2)) / (Cnt - 1)), _
KMarge + .Top + (leMax - Pts(Bcle + 2, 1)) * (.Height - (KMarge * 2)) / (leMax -
leMin))
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


Utilisation dans une cellule:
=LineChart(LaPlage;IndexCouleur)

Exemple là :
http://cjoint.com/?gspRLyujgC

AV






Modeste
Le #4914071
Bonsour® Trirème avec ferveur ;o))) vous nous disiez :

Je recherche une fonction perso dont l'objet est de tracer un
micro-graphique dans une cellule grâce à l'outil de dessin (forme
automatique, ligne, forme libre). Les arguments passés à la fonction sont le
range des cellules à prendre en compte et la couleur du tracé.
Je précise que j'ai vu cette fonction il y a quelques temps, je ne sais plus
ni où ni de qui, et de toute façon, je l'ai perdue.
Si quelqu'un pouvait pallier mon alzheimer naissant, je l'en remercierai.


http://www.dailydoseofexcel.com/archives/2006/02/05/in-cell-charting/
http://www.dailydoseofexcel.com/archives/2006/09/13/scaled-in-cell-charting/

surtout ne pas manquer de lire les commentaires : que des pointures !!!



--
--
@+
;o)))

Trirème
Le #4913721
surtout ne pas manquer de lire les commentaires : que des pointures !!!


En effet, ce fil est l'équivalent Excel du G8 ! Ils sont tous là !

... vais ranger mon clavier et me mettre au tricot.

Cordialement et merci ;-)
Trirème

Francois L
Le #4913211
surtout ne pas manquer de lire les commentaires : que des pointures !!!


En effet, ce fil est l'équivalent Excel du G8 ! Ils sont tous là !

... vais ranger mon clavier et me mettre au tricot.



Salut Trirème,

Sur, DDOE et ses commentateurs, c'est quelque chose... mais fais gaffe,
peut-être qu'ils sont aussi bons en tricot. En tout cas, parmi eux, il y
en a qui s'intéressent au tricot :
http://j-walkblog.com/index.php?/weblog/comments/knitting_your_dog/

--
François L


Trirème
Le #4913021
... En tout cas, parmi eux, il y
en a qui s'intéressent au tricot :
http://j-walkblog.com/index.php?/weblog/comments/knitting_your_dog/

<citation> : "Dog fur is up to 80% warmer then sheep's wool" </citation>

... C'est en quelque sorte l'autre version du hotdog :-P
Mai pour le tricot, qu'importe la matière, l'important c'est qu'il maille à l'endroit
comme à l'envers.
Amicalement,
Trirème

Francois L
Le #4913001
... En tout cas, parmi eux, il y en a qui s'intéressent au tricot :
http://j-walkblog.com/index.php?/weblog/comments/knitting_your_dog/

<citation> : "Dog fur is up to 80% warmer then sheep's wool" </citation>

... C'est en quelque sorte l'autre version du hotdog :-P



Re,

:-)

mais...

http://www.lemonde.fr/web/depeches/0,14-0,,0.html?xtor=RSS-3208

--
François L


jps
Le #4912981
oui mais....
il nous reste encore la toison à Borloo
jps

"Francois L" %23NfT$
... En tout cas, parmi eux, il y en a qui s'intéressent au tricot :
http://j-walkblog.com/index.php?/weblog/comments/knitting_your_dog/

<citation> : "Dog fur is up to 80% warmer then sheep's wool" </citation>

... C'est en quelque sorte l'autre version du hotdog :-P



Re,

:-)

mais...

http://www.lemonde.fr/web/depeches/0,14-0,,0.html?xtor=RSS-3208

--
François L




Francois L
Le #4912941
oui mais....
il nous reste encore la toison à Borloo
jps


Bonsoir Président,

Si Joël vois ça ==> Couic

--
François L

jps
Le #4912921
bonsoir françois
quel couic???? le message BMW du 18/06 à 7h22 est toujours visible....
mais, j'y pense...Joël attend peut-être que ce soit le Président qui lui
donne l'ordre de le supprimer et non pas quelque MVP dont on ne saurait dire
s'il est de la Marche ou du Limousin...
jps

"Francois L"
oui mais....
il nous reste encore la toison à Borloo
jps


Bonsoir Président,

Si Joël vois ça ==> Couic

--
François L



Publicité
Poster une réponse
Anonyme