encore et toujours la couleur

[polo]

bonjour le forum ,

decidement, encore des pb de couleurs .
cela fonctionne a merveille avec la liste deroulante , par contre j aimerais avoir le choix entre taper menuellement dans les cellules les lettres et utiliser la liste deroulante .
dans la macro les cellules se colorient uniquement en utilisant la liste . lorsque je tape M ou A , la cellule ne se colorie pas

merci pour votre aide

 

[charli]

bonjour le forum, Polo

est en utilisant aussi une MFC

@+
charli

 

[polo]

j avais oublié de mettre le fichier
desolé
merci

 

[POLO]

Personne ne veut m aider ??

voici le code :

Private Sub Worksheet_Change(ByVal Target As Range)
With ActiveCell

Select Case UCase(.Value)
Case Is = ''
.Interior.ColorIndex = 2
Case Is = 'M'
.Interior.ColorIndex = 4
Case Is = 'MW'
.Interior.ColorIndex = 4
Case Is = 'S'
.Interior.ColorIndex = 8
Case Is = 'SW'
.Interior.ColorIndex = 8
Case Is = 'N'
.Interior.ColorIndex = 6
Case Is = 'A'
.Interior.ColorIndex = 7
Case Is = 'RPL'
.Interior.ColorIndex = 7
Case Is = 'AST'
.Interior.ColorIndex = 37

End Select
End With
End Sub

en fait , cela fonctionne tres bien avec le menu deroulant mais il me parait plus rapide des fois de saisir directement dans la cellule la lettre de facon a colorier la cellule . j aimerais avoir les 2 possibilites
merci

 

[CBernardT]

Bonjour Polo et tout le monde,

Pour arriver à colorer la cellule après avoir saisi directement dans une cellule et faire ensuite entrée, il faut modifier la macro pour 'viser' cette cellule.

1- S'il n'y a pas l'option 'Déplacer la sélection après validation' la macro telle qu'elle va très bien.

Private Sub Worksheet_Change(ByVal Target As Range)
With ActiveCell.Interior
Select Case UCase(ActiveCell)
Case '': .ColorIndex = xlNone
Case 'M': .ColorIndex = 4
Case 'MW': .ColorIndex = 4
Case 'S': .ColorIndex = 8
Case 'SW': .ColorIndex = 8
Case 'N': .ColorIndex = 6
Case 'A': .ColorIndex = 7
Case 'RPL': .ColorIndex = 7
Case 'AST': .ColorIndex = 37
End Select
End With
End Sub

2- Si l'option 'Déplacer la sélection après validation' et 'Droite' ou 'Bas' sont cochées alors modifier la macro comme suit :

Private Sub Worksheet_Change(ByVal Target As Range)
If Application.MoveAfterReturnDirection = xlDown Then
With ActiveCell.Offset(-1, 0)
Select Case UCase(ActiveCell.Offset(-1, 0))
Case '': .Interior.ColorIndex = xlNone
Case 'M': .Interior.ColorIndex = 4
Case 'MW': .Interior.ColorIndex = 4
Case 'S': .Interior.ColorIndex = 8
Case 'SW': .Interior.ColorIndex = 8
Case 'N': .Interior.ColorIndex = 6
Case 'A': .Interior.ColorIndex = 7
Case 'RPL': .Interior.ColorIndex = 7
Case 'AST': .Interior.ColorIndex = 37
End Select
End With
End If
If Application.MoveAfterReturnDirection = xlToRight Then
With ActiveCell.Offset(0, -1)
Select Case UCase(ActiveCell.Offset(0, -1))
Case '': .Interior.ColorIndex = xlNone
Case 'M': .Interior.ColorIndex = 4
Case 'MW': .Interior.ColorIndex = 4
Case 'S': .Interior.ColorIndex = 8
Case 'SW': .Interior.ColorIndex = 8
Case 'N': .Interior.ColorIndex = 6
Case 'A': .Interior.ColorIndex = 7
Case 'RPL': .Interior.ColorIndex = 7
Case 'AST': .Interior.ColorIndex = 37
End Select
End With
End If
End Sub

Cordialement

CBernardT

Message édité par: CBernardT, à: 21/03/2005 16:30

 

[POLO]

Ce code repond mieux à mon probleme sauf que le passage d'une cellule à l 'autre est un peu lent :

Private Sub Worksheet_Calculate()


Dim Cel As Range
On Error Resume Next
For Each Cel In Range('B6:AF29')
With Cel
Select Case UCase(.Value)
Case Is = ''
.Interior.ColorIndex = 2
Case Is = 'M'
.Interior.ColorIndex = 4
Case Is = 'MW'
.Interior.ColorIndex = 4
Case Is = 'S'
.Interior.ColorIndex = 8
Case Is = 'SW'
.Interior.ColorIndex = 8
Case Is = 'N'
.Interior.ColorIndex = 6
Case Is = 'A'
.Interior.ColorIndex = 7
Case Is = 'RPL'
.Interior.ColorIndex = 7
Case Is = 'AST'
.Interior.ColorIndex = 37


End Select
End With
Next Cel
End Sub