Graphique

Bonsoir à tous,

Je fais face à une problématique que j'espère pouvoir décrire convenablement. Je travaille durant mon stage sur des séries chronologiques de mesure des pluies pour différentes stations. Ayant déjà identifiées les lacunes que présentes chacune de mes séries (stations) j'ai mis mon résultats dans un tableau Excel avec l'identifiant de la station et les lacunes correspondantes (date de début, durée et date de fin) sachant que j'ai plusieurs lacunes par stations.

Je souhaite représenter le tout dans un seul graphique dans lequel je mettrais dans l'axe des abscisses les dates, et les identifiants des stations sur l'axe de ordonnées. ça aurait été simple à faire si j'avais une seule lacune par station (ça aurait été semblable à un diagramme de Gantt) mais du moment que j'en ai plusieurs je ne sais pas comment les aligner horizontalement en fonction de la station correspondante. Pour mieux comprendre cela j'ai fait un petit schéma sur Paint que vous pouvez consulter avec le tableau des lacunes en pièces jointes.

Je reste ouvert à toute autre proposition concernant le type de graphique du moment qu'il soit représentatif.

Je vous remercie d'avance pour votre aide et bonne soirée,

Hichem.

tu n'expliques pas comment tu aurais fait simplement si tu avais une seule lacune par station.

moi je ferais un graphique en nuage de points avec des lignes droites. il faut d'abord, évidement, créer un tableau par jour et par station, et y encoder les lacunes.

Bonjour,

Pour ce qui est de comment faire si j'avais une seule lacune par station, j'aurais créé un diagramme à barre empilé avec une première série contenant la date de début des lacunes par station et une deuxième contenant les durées correspondantes des lacunes.

Concernant la solution que tu proposes je ne suis pas très sûr d'avoir tout compris surtout par rapport au tableau que je dois créer. Une lacune peut s'étendre sur plusieurs jours !

je ferais un tableau en 4 colonnes:

• la première colonne contient la date de chaque jour
• les autres colonnes contiennent le numéro de station, si il y a une lacune pour la station ce jour-là

Bonjour,

Une piste avec un graphique "maison" :

Correction dans le code de la création du graphique, mauvais positionnement des dates. Remplacer la procédure "Graphique() existante par celle-ci :

Sub Graphique()

    Dim Fe As Worksheet
    Dim Plage As Range
    Dim Cel As Range
    Dim Rect As Shape
    Dim Trait As Shape
    Dim Texte As Shape
    Dim Debut As Double
    Dim Fin As Double
    Dim DureeTotale As Double
    Dim DebPeriode As Double
    Dim DureePeriode As Double
    Dim I As Long
    Dim Gauche As Long
    Dim Haut As Integer
    Dim EpaisFleche As Integer
    Dim EpaisTrait As Integer
    Dim Espace As Integer
    Dim Depart As Integer
    Dim Coeff As Single
    Dim Pas As Integer

    Set Fe = ActiveSheet

    Gauche = 400 'par rapport au coté gauche de la feuille
    Haut = 100 'par rapport au haut de la feuille
    Depart = Haut 'mémorise le point
    EpaisFleche = 1
    EpaisTrait = 6
    Espace = 10
    Coeff = 0.2
    Pas = 100 'pour l'inscription des dates, 90 pour tous les trois mois

    'défini la plage à partir de la ligne 2
    Set Plage = DefPlage(Fe, 2, 1)

    'recherche la date minimale et maximale...
    Debut = Application.Min(Plage.Columns(2))
    Fin = Application.Max(Plage.Columns(3))

    '...pour en déduire la durée
    DureeTotale = Fin - Debut

    'supprime tous les shapes sauf le bouton
    For Each Trait In Fe.Shapes
        If Trait.Name <> "BtnGraph" Then Trait.Delete
    Next Trait

    'traçage du graphique :
    For Each Cel In Plage.Columns(2).Cells

        If Cel.Offset(-1, -1).Value <> Cel.Offset(, -1).Value And Cel.Offset(-1, -1).Value <> "Station" Or Cel.Offset(1, -1).Value = "" Then

            'nom des stations
            Set Texte = Fe.Shapes.AddLabel(1, 1, Haut, 100, 20)

            With Texte

                With .TextFrame

                    .Characters.Text = Cel.Offset(-1, -1).Value
                    .AutoSize = True
                    .MarginLeft = 0: .MarginRight = 0: .MarginTop = 0: .MarginBottom = 0

                End With

                .Left = Gauche - .Width
                .Top = Haut - .Height / 3
                .Fill.Transparency = 1
                .Line.Transparency = 1

                'trait horizontal
                Set Trait = Fe.Shapes.AddLine(Gauche, Haut + .Height / 4, Gauche + DureeTotale * Coeff + Espace, Haut + .Height / 4)

            End With

            Haut = Haut + Espace + EpaisTrait

        End If

        'rectangle de période
        DureePeriode = Cel.Offset(, 2).Value * Coeff
        DebPeriode = Gauche + (Cel.Value - Debut) * Coeff

        Set Trait = Fe.Shapes.AddShape(1, DebPeriode, Haut, DureePeriode, EpaisTrait)

    Next Cel

    'trait horizontal
    Set Trait = Fe.Shapes.AddShape(33, Gauche, Haut + Espace, DureeTotale * Coeff + Espace, EpaisFleche)

    'trait vertical
    Set Trait = Fe.Shapes.AddShape(35, Gauche, Depart - Espace, EpaisFleche, Haut - Depart + Espace * 2)

     'création du rectange de fond
    Set Rect = Fe.Shapes.AddShape(1, 1, 1, 1, 1)

    'configuration du rectangle de fond
    With Rect

        .Width = DureeTotale * Coeff + Texte.Width + Espace * 3
        .Top = Depart - Espace * 2
        .Left = Gauche - Texte.Width - Espace
        .Height = Haut - Depart + Espace * 4 + Texte.Width
        .Line.ForeColor.SchemeColor = 23 'couleur max 80
        .Fill.ForeColor.SchemeColor = 1 'couleur max 80
        While .ZOrderPosition > 1: .ZOrder msoSendBackward: Wend

    End With

    'inscription des dates et trais verticaux fonction du pas défini
    For I = Debut To Fin Step Pas

        Set Trait = Fe.Shapes.AddLine(Gauche + (I - Debut) * Coeff, Depart, Gauche + (I - Debut) * Coeff, Haut + Espace)

        Set Texte = Fe.Shapes.AddLabel(1, 1, Haut, 100, 20)

        With Texte

            With .TextFrame

                .Characters.Text = Format(I, "dd/mm/yy")
                .AutoSize = True
                .MarginLeft = 0: .MarginRight = 0: .MarginTop = 0: .MarginBottom = 0

            End With

            .Rotation = 270
            .Left = Gauche - .Width / 2 + (I - Debut) * Coeff
            .Top = Haut + Espace * 2 + EpaisTrait
            .Fill.Transparency = 1
            .Line.Transparency = 1

        End With

    Next I

End Sub

Bonjour,

Désolé, j'ai trouvé encore une erreur dans mon code mais celui-ci devrait être bon cette fois-ci !

J'ai rajouté des couleurs pour différencier les segments entre stations :

Sub Graphique()

    Dim Dico As Object
    Dim Fe As Worksheet
    Dim Plage As Range
    Dim Cel As Range
    Dim Rect As Shape
    Dim Trait As Shape
    Dim Texte As Shape
    Dim Debut As Double
    Dim Fin As Double
    Dim DureeTotale As Double
    Dim DebPeriode As Double
    Dim DureePeriode As Double
    Dim I As Long
    Dim Gauche As Long
    Dim Haut As Integer
    Dim EpaisFleche As Integer
    Dim EpaisTrait As Integer
    Dim Espace As Integer
    Dim Depart As Integer
    Dim Coeff As Single
    Dim Pas As Integer
    Dim Couleur As Integer

    Set Fe = ActiveSheet

    Gauche = 420 'par rapport au coté gauche de la feuille
    Haut = 100 'par rapport au haut de la feuille
    Depart = Haut 'mémorise le point
    EpaisFleche = 1
    EpaisTrait = 6
    Espace = 10
    Coeff = 0.2 'jouer ici pour la taille du graphique
    Pas = 90 'pour l'inscription des dates, 90 pour tous les trois mois

    'défini la plage à partir de la ligne 2
    Set Plage = DefPlage(Fe, 2, 1)

    'recherche la date minimale et maximale...
    Debut = Application.Min(Plage.Columns(2))
    Fin = Application.Max(Plage.Columns(3))

    '...pour en déduire la durée
    DureeTotale = Fin - Debut

    'supprime tous les shapes sauf le bouton
    For Each Trait In Fe.Shapes
        If Trait.Name <> "BtnGraph" Then Trait.Delete
    Next Trait

    Set Dico = CreateObject("Scripting.Dictionary")

    'début de prise ne compte de la palette, attention, maxi 80 !!!
    Couleur = 47

    'traçage du graphique :
    For Each Cel In Plage.Columns(2).Cells

        If Not Dico.exists(Cel.Offset(, -1).Value) Then

            Dico(Cel.Offset(, -1).Value) = ""

            'nom des stations
            Set Texte = Fe.Shapes.AddLabel(1, 1, Haut, 100, 20)

            Haut = Haut + Espace + EpaisTrait

            With Texte

                With .TextFrame

                    .Characters.Text = Cel.Offset(, -1).Value 'Cel.Offset(-1, -1).Value
                    .AutoSize = True
                    .MarginLeft = 0: .MarginRight = 0: .MarginTop = 0: .MarginBottom = 0

                End With

                .Left = Gauche - .Width
                .Top = Haut - .Height / 3
                .Fill.Transparency = 1
                .Line.Transparency = 1

                'trait horizontal
                Set Trait = Fe.Shapes.AddLine(Gauche, Haut + .Height / 4, Gauche + DureeTotale * Coeff + Espace, Haut + .Height / 4)

            End With

            Couleur = Couleur + 1

        End If

        'rectangle de période
        DureePeriode = Cel.Offset(, 2).Value * Coeff
        DebPeriode = Gauche + (Cel.Value - Debut) * Coeff

        Set Trait = Fe.Shapes.AddShape(1, DebPeriode, Haut, DureePeriode, EpaisTrait)

        With Trait

            .Fill.ForeColor.SchemeColor = Couleur
            .Line.ForeColor.SchemeColor = Couleur

        End With

    Next Cel

    'trait horizontal
    Set Trait = Fe.Shapes.AddShape(33, Gauche, Haut + Espace * 2, DureeTotale * Coeff + Espace, EpaisFleche)

    'trait vertical
    Set Trait = Fe.Shapes.AddShape(35, Gauche, Depart - Espace, EpaisFleche, Haut - Depart + Espace * 3)

     'création du rectange de fond
    Set Rect = Fe.Shapes.AddShape(1, 1, 1, 1, 1)

    'configuration du rectangle de fond
    With Rect

        .Width = DureeTotale * Coeff + Texte.Width + Espace * 3
        .Top = Depart - Espace * 2
        .Left = Gauche - Texte.Width - Espace
        .Height = Haut - Depart + Espace * 4 + Texte.Width
        .Line.ForeColor.SchemeColor = 23 'couleur max 80
        .Fill.ForeColor.SchemeColor = 1 'couleur max 80
        While .ZOrderPosition > 1: .ZOrder msoSendBackward: Wend

    End With

    'inscription des dates et trais verticaux fonction du pas défini
    For I = Debut To Fin Step Pas

        Set Trait = Fe.Shapes.AddLine(Gauche + (I - Debut) * Coeff, Depart, Gauche + (I - Debut) * Coeff, Haut + Espace * 2)

        Set Texte = Fe.Shapes.AddLabel(1, 1, Haut, 100, 20)

        With Texte

            With .TextFrame

                .Characters.Text = Format(I, "dd/mm/yy")
                .AutoSize = True
                .MarginLeft = 0: .MarginRight = 0: .MarginTop = 0: .MarginBottom = 0

            End With

            .Rotation = 270
            .Left = Gauche - .Width / 2 + (I - Debut) * Coeff
            .Top = Haut + Espace * 3 + EpaisTrait
            .Fill.Transparency = 1
            .Line.Transparency = 1

        End With

    Next I

End Sub

bonjour

salut g_be , Theze au passage

il est primordial de visualiser les données avant exploitation par méthodes statistiques (tu vas t'y mettre par la suite je pense )

suggestion on fait un graphique par station, et on les superpose

j'ai mis en horizontal, tu peux sans doute passer à une présentation verticale

amitiés à tous

Hello gmb !

Merci beaucoup pour le like

Allez, un dernier code car comme certains segments sont relativement petit, j'ai ajouté une petite sub qui permet en cliquant sur le segment, de connaître ses valeurs (date et durée) mais attention, à l'ouverture du classeur, il faut relancer le traçage du graphique car les valeurs sont stocké en mémoire dans un tableau à deux dimensions qui se détruit à la fermeture du classeur (un appel de la procédure sur "Workbook_Open()" peut palier à la chose) :

La totalité du code :

Dim Tbl()

Sub Graphique()

    Dim Dico As Object
    Dim Fe As Worksheet
    Dim Plage As Range
    Dim Cel As Range
    Dim Rect As Shape
    Dim Trait As Shape
    Dim Texte As Shape
    Dim Debut As Double
    Dim Fin As Double
    Dim DureeTotale As Double
    Dim DebPeriode As Double
    Dim DureePeriode As Double
    Dim I As Long
    Dim Gauche As Long
    Dim Haut As Integer
    Dim EpaisFleche As Integer
    Dim EpaisTrait As Integer
    Dim Espace As Integer
    Dim Depart As Integer
    Dim Coeff As Single
    Dim Pas As Integer
    Dim Couleur As Integer
    Dim NumSegment As Long
    Set Fe = ActiveSheet

    Gauche = 360 'par rapport au coté gauche de la feuille
    Haut = 100 'par rapport au haut de la feuille
    Depart = Haut 'mémorise le point
    EpaisFleche = 1
    EpaisTrait = 6
    Espace = 10
    Coeff = 0.2 'jouer ici pour la taille du graphique
    Pas = 90 'pour l'inscription des dates, 90 pour tous les trois mois

    'défini la plage à partir de la ligne 2
    Set Plage = DefPlage(Fe, 2, 1)

    'recherche la date minimale et maximale...
    Debut = Application.Min(Plage.Columns(2))
    Fin = Application.Max(Plage.Columns(3))

    '...pour en déduire la durée
    DureeTotale = Fin - Debut

    'supprime tous les shapes sauf le bouton
    For Each Trait In Fe.Shapes
        If Trait.Name <> "BtnGraph" Then Trait.Delete
    Next Trait

    Set Dico = CreateObject("Scripting.Dictionary")

    'début de prise ne compte de la palette, attention, maxi 80 !!!
    Couleur = 47

    'traçage du graphique :
    For Each Cel In Plage.Columns(2).Cells

        If Not Dico.exists(Cel.Offset(, -1).Value) Then

            Dico(Cel.Offset(, -1).Value) = ""

            'nom des stations
            Set Texte = Fe.Shapes.AddLabel(1, 1, Haut, 100, 20)

            Haut = Haut + Espace + EpaisTrait

            With Texte

                With .TextFrame

                    .Characters.Text = Cel.Offset(, -1).Value 'Cel.Offset(-1, -1).Value
                    .AutoSize = True
                    .MarginLeft = 0: .MarginRight = 0: .MarginTop = 0: .MarginBottom = 0

                End With

                .Left = Gauche - .Width
                .Top = Haut - .Height / 3
                .Fill.Transparency = 1
                .Line.Transparency = 1

                'trait horizontal
                Set Trait = Fe.Shapes.AddLine(Gauche, Haut + .Height / 4, Gauche + DureeTotale * Coeff + Espace, Haut + .Height / 4)

            End With

            Couleur = Couleur + 1

        End If

        'rectangle de période
        DureePeriode = Cel.Offset(, 2).Value * Coeff
        DebPeriode = Gauche + (Cel.Value - Debut) * Coeff

        Set Trait = Fe.Shapes.AddShape(1, DebPeriode, Haut, DureePeriode, EpaisTrait)

        NumSegment = NumSegment + 1: ReDim Preserve Tbl(1 To 2, 1 To NumSegment)
        Tbl(1, NumSegment) = "Segment_" & NumSegment: Tbl(2, NumSegment) = "Le : " & Cel.Value & vbCrLf & "Durée : " & Round(Cel.Offset(, 2).Value, 2)

        With Trait

            .Name = Tbl(1, NumSegment)
            .Fill.ForeColor.SchemeColor = Couleur
            .Line.ForeColor.SchemeColor = Couleur
            .OnAction = "Message"

        End With

    Next Cel

    'trait horizontal
    Set Trait = Fe.Shapes.AddShape(33, Gauche, Haut + Espace * 2, DureeTotale * Coeff + Espace, EpaisFleche)

    'trait vertical
    Set Trait = Fe.Shapes.AddShape(35, Gauche, Depart - Espace, EpaisFleche, Haut - Depart + Espace * 3)

     'création du rectange de fond
    Set Rect = Fe.Shapes.AddShape(1, 1, 1, 1, 1)

    'configuration du rectangle de fond
    With Rect

        .Width = DureeTotale * Coeff + Texte.Width + Espace * 3
        .Top = Depart - Espace * 2
        .Left = Gauche - Texte.Width - Espace
        .Height = Haut - Depart + Espace * 4 + Texte.Width
        .Line.ForeColor.SchemeColor = 23 'couleur max 80
        .Fill.ForeColor.SchemeColor = 1 'couleur max 80
        While .ZOrderPosition > 1: .ZOrder msoSendBackward: Wend

    End With

    'inscription des dates et trais verticaux fonction du pas défini
    For I = Debut To Fin Step Pas

        Set Trait = Fe.Shapes.AddLine(Gauche + (I - Debut) * Coeff, Depart, Gauche + (I - Debut) * Coeff, Haut + Espace * 2)

        Set Texte = Fe.Shapes.AddLabel(1, 1, Haut, 100, 20)

        With Texte

            With .TextFrame

                .Characters.Text = Format(I, "dd/mm/yy")
                .AutoSize = True
                .MarginLeft = 0: .MarginRight = 0: .MarginTop = 0: .MarginBottom = 0

            End With

            .Rotation = 270
            .Left = Gauche - .Width / 2 + (I - Debut) * Coeff
            .Top = Haut + Espace * 3 + EpaisTrait
            .Fill.Transparency = 1
            .Line.Transparency = 1

        End With

    Next I

End Sub

Function DefPlage(Fe As Worksheet, Optional L As Long = 1, Optional C As Long = 1) As Range

    On Error GoTo Fin

    With Fe

        Set DefPlage = .Range(.Cells(L, C), _
                       .Cells(.Cells.Find("*", .[A1], -4123, , _
                       1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
                       2, 2).Column))

    End With

    Exit Function

Fin:

    Set DefPlage = Nothing

End Function

Sub Message()

    Dim S As Shape
    Dim I As Long

    Set S = ActiveSheet.Shapes(Application.Caller)

    For I = 1 To UBound(Tbl, 2)

        If Tbl(1, I) = S.Name Then MsgBox Tbl(2, I): Exit For

    Next I

End Sub

Hello Jean-Eric !

Merci beaucoup à toi aussi pour le like