Discussion :

[coenonympha]

Bonjour,
Je suis totalement débutant en VBA, je n'y connais rien J'y suis venu par force. Nous remplissons des tableaux excel sur des animaux bagués. ils ont six bagues de couleur différente. Pour plus de simplicité, à chaque couleur correspond un chiffre. On m'a demandé de faire un tableau excel qui transformerai le code rentré en cellules de couleur équivalente. Comme j'ai 6 couleurs en tout, je n'ai pas pu utiliser la mise en forme conditionnelle. J'ai donc trouvé un code en VBA que j'ai adapté comme j'ai pu et qui me convient, le voici :

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
 
'START OF CODE
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim WatchRange As Range
Dim CellVal As String
If Target.Cells.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
CellVal = Target
Set WatchRange = Range("A3:F1000")
 
If Not Intersect(Target, WatchRange) Is Nothing Then
Select Case CellVal
Case 1
Target.Interior.ColorIndex = 5
Target.Font.ColorIndex = 5
Case 2
Target.Interior.ColorIndex = 10
Target.Font.ColorIndex = 10
Case 3
Target.Interior.ColorIndex = 8
Target.Font.ColorIndex = 8
Case 4
Target.Interior.ColorIndex = 46
Target.Font.ColorIndex = 46
Case 5
Target.Interior.ColorIndex = 45
Target.Font.ColorIndex = 45
Case 6
Target.Interior.ColorIndex = 15
Target.Font.ColorIndex = 15
Case 0
Target.Interior.ColorIndex = 0
Target.Font.ColorIndex = 2
 
End Select
End If
End Sub
'END OF CODE

Sauf que maintenant mes collègues trouve que cela serait trop long de rentrer 1 chiffre pas cellule et voudraient rentrer le code de 6 chiffres dans une seule cellule pour avoir 6 cellules à côté qui se colorent.

Du coup, je suis perdu. Si quelqu'un pouvait me sortir de là...

[helios77]

je ne comprends pas bien la fin de ton post
au lieu d'avoir 6 cellules, ils veulent tous les codes dans une seule cellule
Quelles cellules devront être colorées alors ?

Peut tu faire un ptit exemple sur ton fichier et faire une impression d'écran stp ?

[fring]

Bonjour,

Essaye ceci : (les codes se rentrent en colonne A)

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
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Byte
 
If Target.Column <> 1 Or Target.Count > 1 Then Exit Sub
Rows(Target.Row).Interior.ColorIndex = xlNone
For x = 1 To Len(Target.Value)
    Select Case Mid(Target.Value, x, 1)
        Case 1
        Target.Offset(0, x).Interior.ColorIndex = 5
        Target.Offset(0, x).Font.ColorIndex = 5
        Case 2
        Target.Offset(0, x).Interior.ColorIndex = 10
        Target.Offset(0, x).Font.ColorIndex = 10
        Case 3
        Target.Offset(0, x).Interior.ColorIndex = 8
        Target.Offset(0, x).Font.ColorIndex = 8
        Case 4
        Target.Offset(0, x).Interior.ColorIndex = 46
        Target.Offset(0, x).Font.ColorIndex = 46
        Case 5
        Target.Offset(0, x).Interior.ColorIndex = 45
        Target.Offset(0, x).Font.ColorIndex = 45
        Case 6
        Target.Offset(0, x).Interior.ColorIndex = 15
        Target.Offset(0, x).Font.ColorIndex = 15
        Case 0
        Target.Offset(0, x).Interior.ColorIndex = 0
        Target.Offset(0, x).Font.ColorIndex = 2
    End Select
Next
End Sub

[wilfried_42]

bonjour à tous

je ne sais pas si j'ai tout compris mais voila un essai

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
'START OF CODE
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim WatchRange As Range
Dim CellVal As String, i as integer
If Target.Cells.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
CellVal = Target
Set WatchRange = Range("A3:A1000")
 
If Not Intersect(Target, WatchRange) Is Nothing Then
    for i = 1 to len(target.value)
        cellval = val(mid(target,i,1))
Select Case CellVal
Case 1
Target.offset(0,i-1).Interior.ColorIndex = 5
Target.offset(0,i-1).Font.ColorIndex = 5
Case 2
Target.offset(0,i-1).Interior.ColorIndex = 10
Target.offset(0,i-1).Font.ColorIndex = 10
Case 3
Target.offset(0,i-1).Interior.ColorIndex = 8
Target.offset(0,i-1).Font.ColorIndex = 8
Case 4
Target.offset(0,i-1).Interior.ColorIndex = 46
Target.offset(0,i-1).Font.ColorIndex = 46
Case 5
Target.offset(0,i-1).Interior.ColorIndex = 45
Target.offset(0,i-1).Font.ColorIndex = 45
Case 6
Target.offset(0,i-1).Interior.ColorIndex = 15
Target.offset(0,i-1).Font.ColorIndex = 15
Case 0
Target.offset(0,i-1).Interior.ColorIndex = 0
Target.offset(0,i-1).Font.ColorIndex = 2
 
End Select
next i
End If
End Sub
'END OF CODE

oups : bonjour fring, excuse pour la collision (promis je n'ai pas copié )

[coenonympha]

Merci beaucoup à tous, et surtout à Fring (je n'ai pas essayé les autres codes). Ton code marche au poil, pour moi c'est de la magie

merci beaucoup à tous