Graphique individuel

Bonjour,

Voici une piste avec le code suivant à copier dans un module standard

Pour faire un test :
1) Créez une feuille de données (comme dans votre exemple) impérativement à
partir de la cellule "A1". La ligne 1 sera la ligne des titres (abcisses du
graphique)
à partir de la cellule "B1". La colonne 1 sera les légendes des graphiques à
partir
de la cellule "A2".
2) Lancez la macro "ListDropDown" qui va créer une liste de choix.
3) Sélectionnez un item dans la liste de choix et un graphique y
correspondant sera créé.
4) Sélectionnez un autre item et l'ancien graphique laissera la place à un
nouveau

RESTRICTIONS (entre autres)
Le code est au stade prototype et je n'ai pas été plus loin.
Ainsi ne sont pas traités les évènements du classeur et si, par exemple, vous
changez de feuille il est parfois nécessaire de relancer la macro
"ListDropDown"

Les constantes en début de code sont à adapter à votre gré.

*******************
'### Cellule où s'affichera la ListDropDown ###
Const DESTINATION As String = "p2" 'à adapter
Const TYPE_CHART As Long = xlLineMarkers
'##############################################
Private S As Shape
Private var

Sub ListDropDown()
Dim R As Range
Dim Source As Range
Dim i&
Dim Sh As Worksheet
Set Sh = ActiveSheet
Set R = Sh.[a1].CurrentRegion
If R.Rows.Count < 2 Or R.Columns.Count < 2 Then Exit Sub
For Each S In Sh.Shapes
If S.Name = "pmo_dropdown_tempo" Then
S.Delete
Exit For
End If
Next S
With Sh
Set R = .Range(DESTINATION)
Set S = .Shapes.AddFormControl(xlDropDown, _
R.Left, R.Top, R.Width, R.Height)
S.Name = "pmo_dropdown_tempo"
Set Source = .[a1].CurrentRegion
var = Source
End With
Set R = Source.Offset(1, 0)
Set R = R.Resize(R.Rows.Count - 1, R.Columns.Count)
S.ControlFormat.ListFillRange = R.Address
S.OnAction = "actionGraph"
End Sub

Sub actionGraph(Optional dummy As Byte)
Dim Cobj As ChartObject
Dim C As Chart
Dim Lig&
Dim Sh As Worksheet
Dim R1 As Range
Dim R2 As Range
Dim A$
Lig& = S.ControlFormat.Value + 1
Set Sh = ActiveSheet
For Each Cobj In Sh.ChartObjects
If Cobj.Name = "pmo_chart_tempo" Then
Cobj.Delete
Exit For
End If
Next Cobj
Set R1 = Sh.Range(Sh.Cells(1, 2), _
Sh.Cells(1, UBound(var, 2)))
Set R2 = Sh.Range(Cells(Lig&, 2), _
Sh.Cells(Lig&, UBound(var, 2)))
A$ = Application.Union(R1, R2).Address _
(rowabsolute:úlse, columnabsolute:úlse)
Set C = Charts.Add
C.ChartType = TYPE_CHART
On Error Resume Next
C.SetSourceData Source:=Sh.Range(A$), PlotBy:=xlRows
C.SeriesCollection(1).Name = _
"=" & Sh.Name & "!R" & Lig& & "C1"
C.Location Where:=xlLocationAsObject, Name:=Sh.Name
Sh.ChartObjects(Sh.ChartObjects.Count).Name = "pmo_chart_tempo"
End Sub
*******************

Cordialement.

PMO
Patrick Morange