Macro Créer 1 graphique par onglet

[wil]

Bonjour à tous,

Tout d'abord merci de votre aide que je regarde parfois en silence

Je voudrais vous demander un petit service.

Je souhaiterais créer un macro qui
- prend les valeurs dans l'onglet Sheet 1 (cf fichier joint)
- Me permette de créer un graphique XY journalier dans un nouveau onglet à chaque fois (idéalement avec la date comme titre de l'onglet)

De plus si on pouvait ajouter à cela une seconde macro qui dans un nouvel onglet me donne la date et la moyenne journalière alors là ça serait le coeur

Merci d'avance pour votre aide

 

[kjin]

Re : Macro Créer 1 graphique par onglet

Bonjour,
Ajout d' une feuille par date et insertion d' un graphique
Je te laisse mettre la formule pour faire la moyenne les valeurs étant exportées dans chaque feuille

Sub FeuilGraph()
Dim Tablo1() As Variant, Tablo2() As Variant
Application.ScreenUpdating = False
With Sheets("sheet1")

    x = 1
    For i = 2 To .Range("A65000").End(xlUp).Row
        If Weekday(.Cells(i, 1)) <> 0 And IsDate(.Cells(i, 1)) Then
            If Format(.Cells(i, 1), "dd/mm/yy") <> Format(Cells(i + 1, 1), "dd/mm/yy") Then
                ReDim Preserve Tablo1(1 To x)
                Tablo1(x) = Format(.Cells(i, 1).Value, "dd/mm/yy")
                x = x + 1
            End If
        End If
    Next i
    
    For j = 1 To UBound(Tablo1)
        y = 1
        For k = 2 To .Range("A65000").End(xlUp).Row
            If Tablo1(j) = Format(.Cells(k, 1).Value, "dd/mm/yy") Then
                ReDim Preserve Tablo2(1 To 2, 1 To y)
                Tablo2(1, y) = Format(.Cells(k, 1).Value, "hh:mm")
                Tablo2(2, y) = .Cells(k, 2).Value
                y = y + 1
            End If
        Next k
        
        Nom = Format(Tablo1(j), "dd-mm-yy")
        Worksheets.Add after:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = Nom
        ActiveWindow.DisplayGridlines = False
            
            For m = 1 To UBound(Tablo2, 2)
                Cells(m, 1) = Tablo2(1, m)
                Cells(m, 2) = Tablo2(2, m)
            Next m
            
            Set Graph = ActiveSheet.ChartObjects.Add(150, 20, 600, 300)
                With Graph.Chart
                    .ChartType = xlColumnClustered
                    .SeriesCollection.NewSeries
                    .SeriesCollection(1).XValues = Range(Cells(1, 1), Cells(UBound(Tablo2, 2), 1))
                    .SeriesCollection(1).Values = Range(Cells(1, 2), Cells(UBound(Tablo2, 2), 2))
                    .HasTitle = True
                    .ChartTitle.Characters.Text = Nom
                    .HasLegend = False
                    .ChartArea.Border.LineStyle = 0
                    .ChartArea.Interior.ColorIndex = xlNone
                    .PlotArea.Border.LineStyle = xlNone
                    .PlotArea.Interior.ColorIndex = xlNone
                    .Axes(xlValue).MajorGridlines.Delete
                End With
    Next j
End With
Application.ScreenUpdating = True

End Sub

A+
kjin

 

[wil]

Re : Macro Créer 1 graphique par onglet

Salut kjin,

tout d'abord merci de ton aide je suis debutant mais c est cool d aprendre sur l exemple

j ai modifié des details mais j aurais quelques petites questions:
- La feuille reste en portrait et non en paysage comme je le souhaiterais
- mettre en blanc les colonnes avec les données pour qu elles n apparaissent pas a l impression
- centrer le graph sur la page
- rajouter une autre courbe avec colonne C
-avoir l axe des x de ninuit a minuit
comment mettre un nom fixe devant la date (comme valeurs pour le ... avec la date en format mm/dd/yy)

et la moyenne j ai pas trop reussis...

je te laisse ta version la mienne est trop grosse je ne sais pas pourquoi voici le code

 With Graph.Chart
                    .ChartType = xlXYScatterSmoothNoMarkers
                    .SeriesCollection.NewSeries
                    .SeriesCollection(1).XValues = Range(Cells(1, 1), Cells(UBound(Tablo2, 2), 1))
                    .SeriesCollection(1).Values = Range(Cells(1, 2), Cells(UBound(Tablo2, 2), 2))
                    .HasTitle = True
                    .ChartTitle.Characters.Text = Nom
                    .HasLegend = False
                    .ChartArea.Border.LineStyle = 0
                    .ChartArea.Interior.ColorIndex = xlNone
                    .PlotArea.Border.LineStyle = xlNone
                    .PlotArea.Interior.ColorIndex = xlNone
                    .Axes(xlCategory).TickLabels.NumberFormat = "h:mm"
                    .Axes(xlValue).MinimumScale = 0
                    .Axes(xlValue).MaximumScale = 50
                    .Axes(xlValue).MinorUnitIsAuto = True
                    .Axes(xlValue).MajorUnitIsAuto = True
                    .Axes(xlValue).Crosses = xlAutomatic
                    .Axes(xlValue).ReversePlotOrder = False
                    .Axes(xlValue).ScaleType = xlLinear
                    .Axes(xlValue).DisplayUnit = xlNone
                End With