Générer automatiquement des graphs avec selection des sources sur onglets variables

[Nashpuss]

Bonjour,

Je relance un précédent sujet en espérant être un peu plus clair car la je sèche lamentablement.
Je voudrais générer automatiquement des graphiques en choisissant grâce à une UserForm mes séries de données qui sont sur plusieurs onglets différents.
Mais je sais pas trop comment attribuer la liste sélectionnée en donnée source de graphiques, comment faire la boucle…Et dans mon code y a peut être une erreur par ligne.

Plus tard, quand je saurais comment faire ça, faudra aussi que je choississe les données des onglets (Ca sera plus D7307 mais n7:n307 où n est variable).

Private Sub CommandButton2_Click()
    Charts.Add
    ActiveChart.ChartType = xlLineMarkers
    ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="zinzin" 'le nom reste a définir
    ActiveChart.SeriesCollection(1).XValues = Sheets(Me.ListBox2(i, 0)).Range("B7:B307")
    ' Je voudrais que mes abcisse soit J0 à J300 de n'importe quelle feuille. Mais imcompatibilité de type
    For i = 0 To Me.ListBox2.ListCount - 1 'a voir si bien le bon nombre
        ActiveChart.SeriesCollection.NewSeries
        ActiveChart.SeriesCollection(i).Name = Me.ListBox2.List(i, 0)
        'je ne suis pas certain que l'indice i soit accepté par la propriete SeriesCollection.
        ' j'aimerais que ca me donne comme nom celui du premier onglet selectionné lors de la 1ere boucle...
        ActiveChart.SeriesCollection(i).Formula = Sheets(Me.ListBox2.List(i, 0)).Range("D7:D307")
        ' j'aimerais que ca me donne les valeurs en D7:D307 de la premier onglet selectionné lors de la 1ere boucle...
        i = i + 1
    Next i
    With ActiveChart
        .HasTitle = True
        .ChartTitle.Characters.Text = "Sécrétion en fonction du temps"
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Jours"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Sécrétion µg/ml"
        .DisplayBlanksAs = xlInterpolated
        .PlotVisibleOnly = True
        .SizeWithWindow = False
    End With
    Application.ShowChartTipNames = True
    Application.ShowChartTipValues = True
End Sub

Quelqu'un peut m'aider?

Je vosu remercie à l'avance...

 

[Nashpuss]

Re : Générer automatiquement des graphs avec selection des sources sur onglets variab

J'ai l'impression que c'est possible pourtant car j'ai un article ou il font ça (des sources variables sur des onglet diffierents que l'on sélectionne). Par contre je sais pas comment ils ont fait ça. Peut être d'une manière totalement differente..

 

[PMO2]

Re : Générer automatiquement des graphs avec selection des sources sur onglets variab

Bonjour,

Une solution avec la démarche et les codes suivants.

1) Créez un UserForm1 et y insérer
une ListBox1 et une ListBox2, un CommandButton1 et un CommandButton2
un Label1 et une TextBox1, un Label2 et une TextBox2, un Label3 et une TextBox3
Copiez le code suivant dans la fenêtre de code du UserForm

Private Sub CommandButton1_Click()
Dim i&
Dim k&
ListBox2.Clear
For i& = 0 To ListBox1.ListCount - 1
  If ListBox1.Selected(i&) = True Then
    ListBox2.AddItem
    ListBox2.List(k&, 0) = Me.ListBox1.List(i&, 0)
    k& = k& + 1
  End If
Next i&
End Sub

Private Sub CommandButton2_Click()
Dim S1 As Worksheet
Dim S2 As Worksheet
Dim R1 As Range
Dim R2 As Range
Dim CH As Chart
Dim i&
Dim A$
Dim B$
On Error GoTo Erreur
If ListBox2.ListCount = 0 Then Exit Sub
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set S1 = Sheets(TextBox1.Value)
Set S2 = Sheets.Add
Set CH = Charts.Add
ActiveSheet.Move After:=Sheets(Sheets.Count)
S2.Delete
With CH
  .ChartType = xlLineMarkers
  For i& = 0 To ListBox2.ListCount - 1
    Set S2 = Sheets(ListBox2.List(i&, 0))
    Set R1 = S2.Range(TextBox2)
    Set R2 = S2.Range(TextBox3)
    .SeriesCollection.NewSeries
    With .SeriesCollection(i& + 1)
      .Values = "='" & S2.Name & "'!" & R1.Address(, , xlR1C1)
      .XValues = "='" & S2.Name & "'!" & R2.Address(, , xlR1C1)
      .Name = "=""" & S2.Name & """"
    End With
  Next i&
  With .Axes(xlCategory, xlPrimary)
    .HasTitle = True
    .AxisTitle.Characters.Text = "Jours"
  End With
  With .Axes(xlValue, xlPrimary)
    .HasTitle = True
    .AxisTitle.Characters.Text = "Sécrétion µg/ml"
  End With
  With .Axes(xlCategory)
   .MajorTickMark = xlNone
   .MinorTickMark = xlNone
  End With
  .HasTitle = True
  .ChartTitle.Characters.Text = "Sécrétion en fonction du temps"
  .DisplayBlanksAs = xlInterpolated
  .PlotVisibleOnly = True
  .SizeWithWindow = False
  On Error Resume Next
  i& = 0
  A$ = "Groupe séries" 'le nom reste a définir
  B$ = A$
  Do
    Err = 0
    .Location Where:=xlLocationAsNewSheet, Name:=B$
    If Err > 0 Then
      i& = i& + 1
      B$ = A$ & " (" & i& & ")"
    End If
  Loop Until Err = 0
  On Error GoTo Erreur
End With
Application.ShowChartTipNames = True
Application.ShowChartTipValues = True
Erreur:
If Err > 0 And Not CH Is Nothing Then CH.Delete
If Not CH Is Nothing Then Set CH = Nothing
If Not R1 Is Nothing Then Set R1 = Nothing
If Not R2 Is Nothing Then Set R2 = Nothing
If Not S1 Is Nothing Then Set S1 = Nothing
If Not S2 Is Nothing Then Set S2 = Nothing
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Private Sub UserForm_Activate()
Application.EnableEvents = True
End Sub

Private Sub UserForm_Initialize()
Dim i&
Label1 = "Nom de la feuille"
Label2 = "Plage des data"
Label3 = "Plage des étiquettes"
TextBox1.Enabled = False
TextBox2.Enabled = False
If TypeName(ActiveSheet) = "Worksheet" Then
  TextBox1 = ActiveSheet.Name
  TextBox2 = Selection.Address(False, False)
End If
For i& = 1 To Sheets.Count
  If Left(Sheets(i&).Name, 3) = "Run" Then
    ListBox1.AddItem Sheets(i&).Name
  End If
Next i&
ListBox1.MultiSelect = fmMultiSelectExtended
End Sub

2) Dans la fenêtre de code de ThisWorkbook copiez le code suivant

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
With UserForm1
  If TypeName(Sh) = "Chart" Then
    .TextBox1 = ""
    .TextBox2 = ""
  Else
    .TextBox1 = Sh.Name
    .TextBox2 = Sh.Range(Selection.Address).Address(False, False)
  End If
End With
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
With UserForm1
  If TypeName(Sh) = "Chart" Then
    .TextBox2 = ""
  Else
    .TextBox2 = Target.Address(False, False)
  End If
End With
End Sub

3) Le UserForm devra IMPERATIVEMENT être lancé sous cette forme (au moyen d'un Bouton ou d'une Macro)

UserForm1.Show (vbModeless) 'Usage IMPERATIF de (vbModeless)

4) Votre classeur doit contenir une ou plusieurs feuilles "Run x"

CELA FAIT
Une fois le UserForm lancé, activez n'importe quelle feuille "Run" (la TexBox1 affiche le nom de la feuille), sélectionnez la plage des données
(la TextBox2 affiche l'adresse de la plage des données). Indiquez l'adresse de la plage des étiquettes en la tapant dans la TextBox3 (ex B7:B307).
Faites passer les items sélectionnés de la ListBox1 dans la ListBox2 au moyen du CommandButton1.
En appuyant sur le CommandButton2 on obtient un graphique dont le nombre de séries correspond au nombre de feuilles "Run" sélectionnées.

Cordialement.

PMO
Patrick Morange

 

[Nashpuss]

Re : Générer automatiquement des graphs avec selection des sources sur onglets variab

Je te remercie beaucoup PMO2. Le temps de partir en congé, de digérer ta solution (et de la comprendre) et je donne de mes nouvelles...

Nashpuss