Discussion :

[Fennec51]

Bonjour,
c'est mon premier message, je me présente donc : je m'appelle Yann et je suis enseignant.

Pour le suivi de mes élèves, j'ai créer un tableau à double entrée avec les élèves en abscisse et les compétences à valider en ordonnée.

Les compétences sont regroupées en groupe (et les groupes en matière - par exemple vocabulaire) et à chaque groupe de compétence correspond une couleur (dans l'ordre de validation jaune, orange, vert, bleu, marron et noir).

Le nombre de compétence par groupe n'est pas toujours le même.

Je cherche à ce que s'affiche dans une case vide en dessous du nom de chaque élève la couleur du dernier groupe de compétence qu'il a validé.

J'ai défini comme variable chaque plage correspondant à chaque groupe de compétences, puis le nombre de cellules vides dans ce groupe, de sorte que mon programme devrait pour chaque élève vérifier s'il a validé le groupe noir (et coloré la case en noir si oui), si non vérifié s'il a validé le groupe marron (et coloré la case en marron, etc.

Voici donc ce que j'ai écrit :

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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
Sub vocabulaire()
 
Dim plagen As Range
Dim NbcellViden As Integer
 
Dim plagem As Range
Dim NbcellVidem As Integer
 
Dim plageb As Range
Dim NbcellVideb As Integer
 
Dim plagev As Range
Dim NbcellVidev As Integer
 
Dim plageo As Range
Dim NbcellVideo As Integer
 
Dim plagej As Range
Dim NbcellVidej As Integer
 
Dim i As Integer
 
For i = 2 To 19
Cells(4, i).Select
Set plagen = ActiveSheet.Range(Cells(22, i), Cells(24, i))
NbcellViden = plagen.SpecialCells(xlCellTypeBlanks).Count
 
Set plagem = ActiveSheet.Range(Cells(18, i), Cells(21, i))
NbcellVidem = plagem.SpecialCells(xlCellTypeBlanks).Count
 
Set plageb = ActiveSheet.Range(Cells(15, i), Cells(17, i))
NbcellVideb = plageb.SpecialCells(xlCellTypeBlanks).Count
 
Set plagev = ActiveSheet.Range(Cells(11, i), Cells(14, i))
NbcellVidev = plagev.SpecialCells(xlCellTypeBlanks).Count
 
Set plageo = ActiveSheet.Range(Cells(8, i), Cells(10, i))
NbcellVideo = plageo.SpecialCells(xlCellTypeBlanks).Count
 
Set plagej = ActiveSheet.Range(Cells(5, i), Cells(7, i))
NbcellVidej = plagej.SpecialCells(xlCellTypeBlanks).Count
 
If NbcellViden = 0 Then
ActiveCell.Interior.Color = RGB(0, 0, 0)
 
ElseIf NbcellVidem = 0 Then
ActiveCell.Interior.Color = RGB(102, 51, 0)
 
ElseIf NbcellVideb = 0 Then
ActiveCell.Interior.Color = RGB(0, 112, 192)
 
ElseIf NbcellVidev = 0 Then
ActiveCell.Interior.Color = RGB(0, 176, 80)
 
ElseIf NbcellVideo = 0 Then
ActiveCell.Interior.Color = RGB(247, 150, 70)
 
ElseIf NbcellVidej = 0 Then
ActiveCell.Interior.Color = RGB(255, 255, 0)
 
Else
ActiveCell.Interior.Color = RGB(255, 255, 255)
 
End If
 
Next i
 
End Sub

Évidemment, ça ne fonctionne pas, mais je n'arrive pas à trouver pourquoi...

Si l'un d'entre vous peut m'aider, d'avance merci

Yann

[mercatog]

Une proposition générique

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
Sub Vocabulaire()
Dim i As Integer, j As Integer
Dim Tb, Klr
 
Tb = Array(5, 8, 11, 15, 18, 22, 25)                  'Tableau contenant le n° de lignes de chaque groupe en ordre croissant, on y ajoute à la fin la ligne juste en dessous du dernier groupe
Klr = Array(RGB(255, 255, 0), RGB(247, 150, 70), RGB(0, 176, 80), RGB(0, 112, 192), RGB(102, 51, 0), RGB(0, 0, 0))    'Tableau des couleurs de chaque groupe (en ordre décroissant, càa couleur du dernier groupe en premier)
 
With Worksheets("Feuil1")                             'A adapter
    .Cells(4, 2).Resize(, 18).Interior.Color = xlNone
    For i = 2 To 19
        For j = UBound(Tb) - 1 To LBound(Tb) Step -1
            If Application.CountIf(.Cells(Tb(j), i).Resize(Tb(j + 1) - Tb(j)), "") = 0 Then
                .Cells(4, i).Interior.Color = Klr(j)
                Exit For
            End If
        Next j
    Next i
End With
End Sub

[Fennec51]

Et évidemment, ça marche!!!
Il faudra que je prenne le temps (à mon avis beaucoup...) pour comprendre ce que tu as fait, mais en attendant merci!!!
Yann
Problème résolu