message erreur 13 incompatibilité de type

[RICKET]

Bonjour Forum,

J'ai renseigné ce code en évenementielle, et le message d'erreur 'incompatibilité de type Erreur 13' m'est retourné,

L'un d'entre vous aurait-il la bonté de regarder d'où peut venir mon problème ?

Merci d'avance

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim c As Range
For Each c In Range('A3:B500')
Select Case c.Value
Case Is = ''
c.Interior.ColorIndex = 0
Case Is = 'd'
c.Interior.ColorIndex = 12
c.Font.ColorIndex = 12
Case Is = 'D'
c.Interior.ColorIndex = 12
c.Font.ColorIndex = 12
Case Is = 'f'
c.Interior.ColorIndex = 15
c.Font.ColorIndex = 15
Case Is = 'F'
c.Interior.ColorIndex = 15
c.Font.ColorIndex = 15
Case Is = 'c'
c.Interior.ColorIndex = 36
c.Font.ColorIndex = 36
Case Is = 'C'
c.Interior.ColorIndex = 36
c.Font.ColorIndex = 36
Case Is = 'h'
c.Interior.ColorIndex = 7
c.Font.ColorIndex = 7
Case Is = 'H'
c.Interior.ColorIndex = 7
c.Font.ColorIndex = 7
End Select
Next
End Sub

 

[PascalXLD]

Bonjour


J'ai essayé le code et pas de problème

Par contre cela me semble un peu lourd car à chaque changement de ta feuille où que ce soit tu refais toute la mise en couleur de tes cellules (tu perds un temps fou pour rien)

je te propose

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range('A3:B500')) Is Nothing Then
Select Case Target.Value
Case Is = ''
Target.Interior.ColorIndex = 0
Case Is = 'd'
Target.Interior.ColorIndex = 12
Target.Font.ColorIndex = 12
Case Is = 'D'
Target.Interior.ColorIndex = 12
Target.Font.ColorIndex = 12
Case Is = 'f'
Target.Interior.ColorIndex = 15
Target.Font.ColorIndex = 15
Case Is = 'F'
Target.Interior.ColorIndex = 15
Target.Font.ColorIndex = 15
Case Is = 'c'
Target.Interior.ColorIndex = 36
Target.Font.ColorIndex = 36
Case Is = 'C'
Target.Interior.ColorIndex = 36
Target.Font.ColorIndex = 36
Case Is = 'h'
Target.Interior.ColorIndex = 7
Target.Font.ColorIndex = 7
Case Is = 'H'
Target.Interior.ColorIndex = 7
Target.Font.ColorIndex = 7
End Select
End If
End Sub

Bon courage

 

[RICKET]

Merci Pascal,

Au changement de caractère dans la cellule ça fonctionne, et ça me permet de bien avancer, cependant quand je selectionne dans ma plage au moins deux cellules pour effacer le contenu, le message d'erreur 13 m'est toujours retourné et le débogueur s'arrête sur ' Case Is = '' '

As-tu une autre idée ?

Merci encore

RICKET

 

[PascalXLD]

Re

en traitant cette erreur

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim c As Range

If Not Intersect(Target, Range('A3:B500')) Is Nothing Then
For Each c In Target
Select Case c.Value
Case Is = ''
c.Interior.ColorIndex = 0
Case Is = 'd'
c.Interior.ColorIndex = 12
c.Font.ColorIndex = 12
Case Is = 'D'
c.Interior.ColorIndex = 12
c.Font.ColorIndex = 12
Case Is = 'f'
c.Interior.ColorIndex = 15
c.Font.ColorIndex = 15
Case Is = 'F'
c.Interior.ColorIndex = 15
c.Font.ColorIndex = 15
Case Is = 'c'
c.Interior.ColorIndex = 36
c.Font.ColorIndex = 36
Case Is = 'C'
c.Interior.ColorIndex = 36
c.Font.ColorIndex = 36
Case Is = 'h'
c.Interior.ColorIndex = 7
c.Font.ColorIndex = 7
Case Is = 'H'
c.Interior.ColorIndex = 7
c.Font.ColorIndex = 7
End Select
Next
End If
End Sub

Bon courage

 

[RICKET]

Merci pour tout Pascal,

J'ai complétement réglé mon problème.

C'est beau la connaissance....

 

[ChTi160]

Salut' RICKET et pascal76

je me permet cette intrusion pour poser la question suivante ne peut on pas réduire le code en introduisant un Lcase?
ou UCase
soit
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim c As Range

If Not Intersect(Target, Range('A3:B500')) Is Nothing Then
For Each c In Target

Select Case LCase( c.Value)
Case Is = ''
c.Interior.ColorIndex = 0

Case Is = 'd'
c.Interior.ColorIndex = 12
c.Font.ColorIndex = 12

Case Is = 'f'
c.Interior.ColorIndex = 15
c.Font.ColorIndex = 15

Case Is = 'c'
c.Interior.ColorIndex = 36
c.Font.ColorIndex = 36

Case Is = 'h'
c.Interior.ColorIndex = 7
c.Font.ColorIndex = 7

End Select
Next
End If
End Sub
Amicalement
Jean Marie

Message édité par: ChTi160, à: 06/04/2005 21:50