Bonjour tout le monde.
Afin de faire ressortir une progression de résultats, je me posais la
question de savoir s'il était possible, à partir d'une base de données, de
créer un graphique indiduel à partir d'une liste à choix de noms couplée
avec les données correspondantes au nom.
C'est à dire ; ligne1 = Nom1 + données1 = graphique1 -- ligne2 = Nom2 +
données2 = graphique2
Un petit classeur exemple.
Si quelqu'un avait une idée. Merci
Phil
http://cjoint.com/?mpoX5ljhnS
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
PMO
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
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
*******************
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 *******************