Discussion :

[a.ouguerzam]

Bonjour,

J’ai besoin de vous pour assemble deux code VBA que j’ai sur deux boutons ont un seul bouton
Le 1er code permet de calcule les différentes quartile présence sur une plage
2eme code permet de colorie les différents quartile sur un croisé dynamique

Ci-dessous les codes

1er code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub QUARTILE_Par_Agent()
 
Dim Ligne As Integer
Ligne = 2
    For i = 46 To 49
        For j = 5 To 38 
            If Cells(j, 2) <= Cells(i, 2) And Cells(j, 2) > Cells(i - 1, 2) Then
                Cells(Ligne, 7) = Cells(i, 1)
                Cells(Ligne, 8) = Cells(j, 1)
                Cells(Ligne, 9) = Cells(j, 2)
                Ligne = Ligne + 1
            End If
        Next
    Next
End Sub

2eme code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Public Sub CouleurQ()
Dim ws As Worksheet, pt As PivotTable, rngData As Range
 
    With Application
        .PivotTableSelection = True: .ScreenUpdating = False
    End With
 
    Set ws = ActiveSheet: Set pt = ws.PivotTables(1)
    Set rngData = _
            Intersect(pt.PivotFields("Quartile").PivotItems("Q1").DataRange.EntireRow, _
            pt.PivotFields("Les noms").DataRange)
    Set rngData = _
            Union(rngData, pt.PivotFields("Quartile").PivotItems("Q1").LabelRange, _
            pt.PivotFields("Quartile").PivotItems("Q1").DataRange)
    rngData.Interior.Color = vbRed
 
 
        Set ws = ActiveSheet: Set pt = ws.PivotTables(1)
    Set rngData = _
            Intersect(pt.PivotFields("Quartile").PivotItems("Q2").DataRange.EntireRow, _
            pt.PivotFields("Les noms").DataRange)
    Set rngData = _
            Union(rngData, pt.PivotFields("Quartile").PivotItems("Q2").LabelRange, _
            pt.PivotFields("Quartile").PivotItems("Q2").DataRange)
    rngData.Interior.Color = RGB(255, 165, 0)
 
 
            Set ws = ActiveSheet: Set pt = ws.PivotTables(1)
    Set rngData = _
            Intersect(pt.PivotFields("Quartile").PivotItems("Q3").DataRange.EntireRow, _
            pt.PivotFields("Les noms").DataRange)
    Set rngData = _
            Union(rngData, pt.PivotFields("Quartile").PivotItems("Q3").LabelRange, _
            pt.PivotFields("Quartile").PivotItems("Q3").DataRange)
    rngData.Interior.Color = vbYellow
 
 
 
                Set ws = ActiveSheet: Set pt = ws.PivotTables(1)
    Set rngData = _
            Intersect(pt.PivotFields("Quartile").PivotItems("Q4").DataRange.EntireRow, _
            pt.PivotFields("Les noms").DataRange)
    Set rngData = _
            Union(rngData, pt.PivotFields("Quartile").PivotItems("Q4").LabelRange, _
            pt.PivotFields("Quartile").PivotItems("Q4").DataRange)
    rngData.Interior.Color = RGB(0, 200, 100)
 
 
    Set rngData = Nothing: Set pt = Nothing: Set ws = Nothing
 
End Sub

[parmi]

Bonjour,

Tu n'as qu'à appeler tes 2 macros lors du click sur le bouton.
Par exemple, tu crées une macro Départ que tu lies à un bouton.

Le code de cette macro

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Sub Départ()
   Call QUARTILE_Par_Agent
   Call CouleurQ
End Sub

[a.ouguerzam]

Good ça marche merci bcq bien noté et bien sauvegarde