MFC Sur Histogramme

Le 23/03/2022 à 20:09

Bonjour j'ai un histogramme avec une courbe comme objectif et des colonnes en réel, est il possible des mettre les colonnes qui sont 10% en dessous de la ligne objectif en couleur rouge par exemple

8exemp.xlsx (66.44 Ko)

. je mets en pj un fichier

Merci

Le 24/03/2022 à 10:00

bonjour,

En cliquant 1 fois sur le graphique, cela applique la couleur sur les barres de l'histogramme.

22nelson29-mfc-sur-histogramme.xlsm (63.80 Ko)

Cdlt

Le 25/03/2022 à 08:57

Merci pour le retour, mais j'ai une erreur sur la ligne

If Cells(i, "D") < Cells(i, "E") - (Cells(i, "E") * 0.1) Then
.Points(i - 3).Interior.ColorIndex = 3
Else
.Points(i - 3).Interior.ColorIndex = 33
End If

Je précise que sur le fichier original les données sont glissants en fonction du mois pour récupérer les données

Le 26/03/2022 à 07:29

Bonjour,

Je précise que sur le fichier original les données sont glissants en fonction du mois pour récupérer les données

Vos précisions sont insuffisantes.
Quand vous dites que les données sont glissantes, est-ce au jour le jour pour un nombre de jours fixes dans la plage (exemples: du 1er au 31 du mois, puis du 2 au 1er du mois suivant , puis du 3 au 2 du mois suivant, etc...) ou bien, glissantes mois par mois (ce que je suppose être), dans ce cas, comment sélectionnez-vous la plage de données du mois actuellement? le faites-vous manuellement quand vous décidez de prendre tel ou tel mois à afficher, ou bien comptez-vous utiliser une liste déroulante pour choisir le mois? De votre réponse découlera une réponse appropriée.

Cdlt

Le 28/03/2022 à 09:05

Bonjour, j'ai un menu déroulant pour le mois en cours et quand je choisis par exemple Mars la sélection des données glisse sur la date du 1er mars au 31 mars (mois par mois) avec une macro.

Cdlt

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Plage As Object
On Error GoTo Sortie
Application.EnableEvents = False
If Target.Address = "$H$1" Then
Application.ScreenUpdating = False
Select Case Range("H1").Value
Case "JANVIER"
Set Plage = Range("B4:E34")
Lig = 4
decalage = 0
Case "FEVRIER"
Set Plage = Range("B35:E63")
Lig = 35
decalage = -1
Case "MARS"
Set Plage = Range("B64:E94")
Lig = 64
decalage = -2
Case "AVRIL"
Set Plage = Range("B95:E1244")
Lig = 95
decalage = -3
Case "MAI"
Set Plage = Range("B125:E155")
Lig = 125
decalage = -4
Case "JUIN"
Set Plage = Range("B156:E185")
Lig = 156
decalage = -5
Case "JUILLET"
Set Plage = Range("B186:E216")
Lig = 186
decalage = -6
Case "AOUT"
Set Plage = Range("B217:E247")
Lig = 217
decalage = -7
Case "SEPTEMBRE"
Set Plage = Range("B248:E277")
Lig = 248
decalage = -8
Case "OCTOBRE"
Set Plage = Range("B278:E308")
Lig = 278
decalage = -9
Case "NOVEMBRE"
Set Plage = Range("B309:E338")
Lig = 309
decalage = -10
Case "DECEMBRE"
Set Plage = Range("B339:E369")
Lig = 339
decalage = -11
End Select

ActiveSheet.ChartObjects("Graphique 12").Activate
With ActiveChart
.PlotArea.Select
.SetSourceData Source:=Plage
.HasTitle = True
.ChartTitle.Characters.Text = Range("H1").Value
End With
ActiveChart.SeriesCollection(1).Name = "=""Cpts Visités"""
ActiveChart.SeriesCollection(2).Name = "=""Objectif"""
End If
Sortie:
Application.EnableEvents = True
End Sub

Le 28/03/2022 à 10:44

Bonjour,

Copiez ce code dans le module de la feuille, et supprimez la macro "Couleur" précédemment fournie, ainsi que l'affectation de la macro "couleur "au graphique.

En sélectionnant le mois, cela devrait tout faire dans la foulée et placer le graphique en face du mois sélectionné.

Option Compare Text
    Dim LigDeb As Long, DerLig As Long, i As Long

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Plage As Object
    On Error GoTo Sortie
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    If Target.Address = "$H$1" Then
        Application.ScreenUpdating = False
        Select Case Range("H1").Value
            Case "JANVIER"
                Set Plage = Range("B4:E34")
                LigDeb = 4
                DerLig = 34
            Case "FEVRIER"
                Set Plage = Range("B35:E63")
                LigDeb = 35
                DerLig = 63
            Case "MARS"
                Set Plage = Range("B64:E94")
                LigDeb = 64
                DerLig = 94
            Case "AVRIL"
                Set Plage = Range("B95:E124")
                LigDeb = 95
                DerLig = 124
            Case "MAI"
            Set Plage = Range("B125:E155")
                LigDeb = 125
                DerLig = 155
            Case "JUIN"
                Set Plage = Range("B156:E185")
                LigDeb = 156
                DerLig = 185
            Case "JUILLET"
                Set Plage = Range("B186:E216")
                LigDeb = 186
                DerLig = 216
            Case "AOUT"
                Set Plage = Range("B217:E247")
                LigDeb = 217
                DerLig = 247
            Case "SEPTEMBRE"
                Set Plage = Range("B248:E277")
                LigDeb = 248
                DerLig = 277
            Case "OCTOBRE"
                Set Plage = Range("B278:E308")
                LigDeb = 278
                DerLig = 308
            Case "NOVEMBRE"
                Set Plage = Range("B309:E338")
                LigDeb = 309
                DerLig = 338
            Case "DECEMBRE"
                Set Plage = Range("B339:E369")
                LigDeb = 339
                DerLig = 369
        End Select

        ActiveSheet.ChartObjects("Graphique 12").Activate
        With ActiveChart
            .PlotArea.Select
            .SetSourceData Source:=Plage
            .HasTitle = True
            .ChartTitle.Characters.Text = Range("H1").Value
        End With

        With ActiveChart.SeriesCollection(1)
            For i = LigDeb To DerLig
                If Cells(i, "D") < Cells(i, "E") - (Cells(i, "E") * 0.1) Then
                    .Points(i - LigDeb + 1).Interior.ColorIndex = 3
                Else
                    .Points(i - LigDeb + 1).Interior.ColorIndex = 33
                End If
            Next
        End With

        ActiveChart.SeriesCollection(1).Name = "=""Cpts Visités"""
        ActiveChart.SeriesCollection(2).Name = "=""Objectif"""
    End If

    Range("L18").Select
    If LigDeb > 39 Then
        ActiveWindow.ScrollRow = LigDeb - 6
        Hauteur_de_lig = Rows(4).RowHeight
        ActiveSheet.ChartObjects("Graphique 12").Top = (LigDeb * Hauteur_de_lig) + 10
    End If
Sortie:
    Application.EnableEvents = True
End Sub

Cdlt

Le 28/03/2022 à 13:25

Re Bonjour, après avoir copié le code le graphique se mets bien en face du mois mais je n'est plus mes colonnes, la sources de données pourtant est au bonne endroit

Cdlt

annotation 2022 03 28 132203
Le 28/03/2022 à 15:26

Le mois sélectionné est -il rempli de données?

Le 29/03/2022 à 08:41

Bonjour

Oui oui le tableau prends en compte les objectifs et le récap des données apparait sur le tableau du bas

annotation 2022 03 29 084113
Le 29/03/2022 à 09:45

Bonjour,

Pourriez-vous redéposer le fichier avec les données complètes?

Mais avant remplacez le code existant par celui-ci:

Option Compare Text
    Dim LigDeb As Long, DerLig As Long, i As Long

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Plage As Object
    On Error GoTo Sortie
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    If Target.Address = "$H$1" Then
        Application.ScreenUpdating = False
        Select Case UCase(Range("H1").Value)
            Case "JANVIER"
                Set Plage = Range("B4:E34")
                LigDeb = 4
                DerLig = 34
            Case "FEVRIER"
                Set Plage = Range("B35:E63")
                LigDeb = 35
                DerLig = 63
            Case "MARS"
                Set Plage = Range("B64:E94")
                LigDeb = 64
                DerLig = 94
            Case "AVRIL"
                Set Plage = Range("B95:E124")
                LigDeb = 95
                DerLig = 124
            Case "MAI"
            Set Plage = Range("B125:E155")
                LigDeb = 125
                DerLig = 155
            Case "JUIN"
                Set Plage = Range("B156:E185")
                LigDeb = 156
                DerLig = 185
            Case "JUILLET"
                Set Plage = Range("B186:E216")
                LigDeb = 186
                DerLig = 216
            Case "AOUT"
                Set Plage = Range("B217:E247")
                LigDeb = 217
                DerLig = 247
            Case "SEPTEMBRE"
                Set Plage = Range("B248:E277")
                LigDeb = 248
                DerLig = 277
            Case "OCTOBRE"
                Set Plage = Range("B278:E308")
                LigDeb = 278
                DerLig = 308
            Case "NOVEMBRE"
                Set Plage = Range("B309:E338")
                LigDeb = 309
                DerLig = 338
            Case "DECEMBRE"
                Set Plage = Range("B339:E369")
                LigDeb = 339
                DerLig = 369
        End Select

        ActiveSheet.ChartObjects("Graphique 12").Activate
        With ActiveChart
            .PlotArea.Select
            .SetSourceData Source:=Plage
            .HasTitle = True
            .ChartTitle.Characters.Text = Range("H1").Value
        End With

        With ActiveChart.SeriesCollection(1)
            For i = LigDeb To DerLig
                If Cells(i, "D") < Cells(i, "E") - (Cells(i, "E") * 0.1) Then
                    .Points(i - LigDeb + 1).Interior.ColorIndex = 3
                Else
                    .Points(i - LigDeb + 1).Interior.ColorIndex = 33
                End If
            Next
        End With

        ActiveChart.SeriesCollection(1).Name = "=""Cpts Visités"""
        ActiveChart.SeriesCollection(2).Name = "=""Objectif"""
    End If

    Range("L18").Select
    If LigDeb > 39 Then
        ActiveWindow.ScrollRow = LigDeb - 6
        Hauteur_de_lig = Rows(4).RowHeight
        ActiveSheet.ChartObjects("Graphique 12").Top = (LigDeb * Hauteur_de_lig) + 10
    Else
        ActiveSheet.ChartObjects("Graphique 12").Top = 70
    End If
Sortie:
    Application.EnableEvents = True
End Sub

Cdlt

Le 29/03/2022 à 13:33

Super ça fonctionne j'ai vu que tu avais rajouté la ligne, juste pour info elle sert à quoi

ActiveSheet.ChartObjects("Graphique 12").Top = 70

Le 29/03/2022 à 13:39

Juste un détail pour le mois de février le tableau se mets en face de janvier!! c'est le seul mois qui ne fonctionne pas pour le positionnement du graphique

Le 29/03/2022 à 14:45

70= position haute du graphique,

La hauteur des lignes étant = 15, pour placer le graphique à la bonne hauteur, il suffit de multiplier la hauteur de lignes par 15,

le mois de janvier commence à la ligne 4, 4*15 = 60 , avec une marge supplémentaire de 10, ça fait 70, essayez d'autres valeurs et vous comprendrez.

****************************************************

A cette ligne:

    If LigDeb > 39 Then

remplacez 39 par 34

******************************************************

Cdlt

Le 30/03/2022 à 08:47

Merci pour les explications une dernière petite info (uniquement si je peux rajouter une ligne sans tout modifier) est il possible de rajouter dans le code une ligne pour ajouté une couleur supplémentaire avec une autre valeur qui serait 5% par exemple, j'ai essayé ceci mais en vain

With ActiveChart.SeriesCollection(1)
For i = LigDeb To DerLig
If Cells(i, "D") < Cells(i, "E") - (Cells(i, "E") * 0.1) Then
.Points(i - LigDeb + 1).Interior.ColorIndex = 3
End If
If Cells(i, "D") < Cells(i, "E") - (Cells(i, "E") * 0.05) Then
.Points(i - LigDeb + 1).Interior.ColorIndex = 33
Else
.Points(i - LigDeb + 1).Interior.ColorIndex = 4
End If
Next
End With

Le 30/03/2022 à 08:50

C'était bien ça j'ai mis 34 et mes lignes font 13 pour le coup j'ai mis 60 ça fonctionne parfaitement

Merci

Cdlt

Le 30/03/2022 à 09:58

Bonjour,

Comme ceci:

        With ActiveChart.SeriesCollection(1)
            For i = LigDeb To DerLig
                If Cells(i, "D") < Cells(i, "E") - (Cells(i, "E") * 0.1) Then
                    .Points(i - LigDeb + 1).Interior.ColorIndex = 3
                ElseIf Cells(i, "D") < Cells(i, "E") - (Cells(i, "E") * 0.05) Then
                    .Points(i - LigDeb + 1).Interior.ColorIndex = 33
                Else
                    .Points(i - LigDeb + 1).Interior.ColorIndex = 4
                End If
            Next
        End With

Cdlt

Edit:

Ou plutôt comme ceci:

        With ActiveChart.SeriesCollection(1)
            For i = LigDeb To DerLig
                If Cells(i, "D") < Cells(i, "E") - (Cells(i, "E") * 0.05) Then
                    .Points(i - LigDeb + 1).Interior.ColorIndex = 33
                ElseIf Cells(i, "D") < Cells(i, "E") - (Cells(i, "E") * 0.1) Then
                    .Points(i - LigDeb + 1).Interior.ColorIndex = 3
                Else
                    .Points(i - LigDeb + 1).Interior.ColorIndex = 4
                End If
            Next
        End With
Le 30/03/2022 à 10:58

Merci j'ai du inverser les lignes (10% et 5% ) autrement il ne prenait pas en compte la couleur intermédiaire.

If Cells(i, "D") < Cells(i, "E") - (Cells(i, "E") * 0.1) Then
.Points(i - LigDeb + 1).Interior.ColorIndex = 3
ElseIf Cells(i, "D") < Cells(i, "E") - (Cells(i, "E") * 0.05) Then
.Points(i - LigDeb + 1).Interior.ColorIndex = 45
Else
.Points(i - LigDeb + 1).Interior.ColorIndex = 4

Merci encore

Une bonne journée

Cdlt

Rechercher des sujets similaires à "mfc histogramme"