Macro Coloriage qui plante

[alain.raphael]

Bonjour à Tous,

J'ai une erreur du type : Run-time error '-2147024809 (80070057)': The specific value is out of range

Peut-être une erreur de noms de propriété...ou autre....

Impossible de trouver cette erreur....

Si quelqu'un a une idée ?

Sub coloriage()
Dim couleur As Long, c As Range, ca As Range, p As Long
For Each c In Range("R6:R231").Cells
If c <> "" Then
Set ca = c.Offset(, 1)
p = Application.Match(ca, [legende], 1)
couleur = Range("legende").Cells(p, 1).Interior.Color
ActiveSheet.Shapes(c).Fill.ForeColor.RGB = couleur
End If
Next c
End Sub

Merci !

 

[Hasco]

Bonjour,

Sur quelle Ligne ???

En tous cas je vois une erreur sur les lignes:

Set ca = c.Offset(, 1)
p = Application.Match(ca, [legende], 1)

La valeur de la variable range ca est de type String
Et vous cherchez cette valeur dans un tableau de valeurs numériques.
Application.Match (équivalent de Equiv) retournera #/NA ou en vba xlCvError.xlErrNA

Quand vous utilisez des fonctions excel en vba, mieux vaut déclarer leur variable de retour en type Variant et faire ensuite un test de retour.:

Dim p as variant
p = Application.Match.....
If IsError(p) then
'je traite l'erreur
Else
' continue.
End If

Bonne soirée

 

[youky(BJ)]

Bonjour Alain,
Ceci doit le faire.
Bruno

Sub coloriage()
Dim couleur As Long, c As Range, ca As Range, p As Long
  For Each c In Range("Q6:Q231").Cells
   If c.Value <> "" Then
     p = Application.Match(Val(c.Offset(, 1)), [legende], 0)
     couleur = Range("legende").Cells(p, 1).Interior.Color
     ActiveSheet.Shapes(c.Value).Fill.ForeColor.RGB = couleur
   End If
  Next c
End Sub

 

[alain.raphael]

Merci à vous 2.....

Cela marche impeccable Youky....

Pourras-tu me dire ce qu'il clochait ?

Un GRAND Merci !!

 

[youky(BJ)]

Yes,
Les chiffres indiqués en col R sont en text car dans la formule il aurait fallu enlever certain """"
toi =SI(S22="Moyen";"3";.... va renvoyer 3 en text et non en chiffre
il aurait été mieux =SI(S22="Moyen";3;SI(S22="Faible";1
Donc je n'ai rien changé mais en macro je converti en chiffre avec val(le chiffres en text)
j'ai modifié Range("Q6:Q231") je crois c'était R6:R231
application.match mis 0 au lieu de 1
0 est valeur exact et 1 valeur la plus proche
Ben voila
Bon Week-end
Bruno

 

[alain.raphael]

MERCI !