Coloriage par VBA de Formes

[alain.raphael]

Bonjour à Tous,
J'ai une erreur d'exécution 13 (incompatibilité de type) lorsque j'essaie d'effectuer cette macro :

Sub coloriage()
For Each c In [régionszone1]
If c <> "" Then
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

Le problème viendrait de ma légende qu'il ne reconnaitrait pas. J'ai tout essayé : différents formats (Texte..) mais j'ai toujours l'erreur. Pourtant ma légende est composeé de 2 cellules, une avec 0 en blanc et l'autre avec une x en rouge...

Des idées ?

 

[Staple1600]

Bonjour le fil, le forum

@alain.raphael
Des idées?
Oui, une
Par exemple que tu penses à joindre un fichier exemple pour qu'on puisse faire des tests
(et accessoirement ne pas perdre de temps à recréer un fichier qui existe déjà sur ton disque dur)

Chez moi, ce petit test fonctionne parfaitement
(mais chez moi, je n'ai pas ton fichier )

Sub test()
Dim sh As Shape, i&, couleur&
i = 1
For Each sh In ActiveSheet.Shapes
Cells(i, 1).Value = sh.Name
Cells(i, 2).Value = sh.Type
couleur = Cells(i, 1).Interior.Color
sh.Fill.ForeColor.RGB = couleur
i = i + 1
Next
End Sub

 

[alain.raphael]

Merci Staple....

Mais ce fichier fait 6Mo, difficilement allégeable.....et plutôt avec des informations privées...

 

[alain.raphael]

J'ai un autre fichier exemple....mais celui-là marche correctement.

 

[alain.raphael]

Je cherche à changer ces 2 lignes par d'autres équivalentes....

p = Application.Match(ca, [legende], 1)
couleur = Range("legende").Cells(p, 1).Interior.Color

Lorsque je met change.Cells(p,1) par change.Cells(4,1) 4 étant la ligne ou se trouve la couleur du fond de cellule à recopier...... cela passe mais il me colorie toutes les formes et non plus ceux qu'il me faut....mais c'est déjà un progrès...

 

[Staple1600]

Re

@alain.raphael

Merci Staple....

Mais ce fichier fait 6Mo, difficilement allégeable.....et plutôt avec des informations privées...

La coutume sur le forum depuis que la Cellule est Cellule et qu'OptionExplicit est notre grand Vizir à plumes, c'est de créer un fichier exemple pour illustrer la question (et de donc jamais, O grand jamais , joindre le fichier original)

C'est qu'on peut lire dans le Grand Livre Sacré (communément appelé charte du forum)

Toi qui es inscrit depuis 2014 devrait savoir cela, camarade

 

[Staple1600]

Re

Personnellement et si j'étais moi, j'aurai ajouté ces déclarations

Sub coloriage()
Dim couleur&, c As Range
  For Each c In [régionszone1]
   If c <> "" Then
     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

 

[alain.raphael]

Merci Staple pour les déclarations....mais j'ai toujours le même problème d'erreur d'exécution 13.

Après recherche, j'ai trouvé une incompréhension : J'ai 2 colonnes : une avec des noms de régions, l'autre avec des croix sur certaines régions seulement.

For Each c In [régionszone]
If c <> "" Then
ca = c.Offset(, 1) (autrement dit la colonne à côté sans ligne)
p = Application.Match(ca, [legende], 1)
(avec une légende de couleur A1= 0 (blanc) et A2=(X) avec un fond de couleur ROUGE)
couleur = Range("legende").Cells(p, 1).Interior.Color
ActiveSheet.Shapes(c).Fill.ForeColor.RGB = couleur

Or, ceci me donne l'erreur 13.

Du coup lorsque je nomme dans Gestionnaire de noms cette fameuse 2ème colonne par admettons : Colonne2, et si je remplace ca dans la 2ème ligne par Colonne2, on a donc :

p = Application.Match(colonne2, [legende], 1)

Alors PLUS d'erreur 13........ mais problème il me colorie tout, il ne prends pas en compte QUE les régions qui ont une croix à côté......

 

[Staple1600]

Bonjour le fil, le forum

[moue dubitative du dimanche matin au saut du lit]
Si j'étais moi, et que j'avais à dispostion un fichier qui fonctionne correctement, bah j'utiliserai ce fichier.
Et je vouerai le fichier dysfonctionniel aux gémonies.
[/moue dubitative du dimanche matin au saut du lit]

 

[alain.raphael]

Je suis désolé de ne pas pouvoir vous envoyer le fichier qui ne marche pas....

Le fichier exemple est simplifié est ne possède pas l'erreur......que je viens de trouver !!!!

L'erreur :

En face des régions en 1ère colonne, j'ai des croix ou non. Le code doit colorier les régions qui ont des croix en 2ème colonne.
Cela marche parfaitement si les cellules (en 2ème colonne) ont incrémentés soit des croix, soit rien, ce qui parait normal.

Seul problème, c'est que ces cellules en 2ème colonne sont le résultat d'une formule de type :


=SIERREUR(SI(ET($A$1=1;$A$9=1);RECHERCHEV($R9;ZoneFU;2;0)........;"")

La formule va rechercher des croix....ou rien ("").

Ce qui me sort une erreur de type 13 pour mon VBA.

(Par ailleurs que je mette "" ou 0 à la place dans la formule, c'est pareil)


Je pense que je suis pas loin!!!

MERCI



Pour info, ci-dessous la légende que reprends le code :
https://www.hostingpics.net/viewer.php?id=951438legende.png

 

[Staple1600]

Re

@alain.raphael
Pourquoi avoir retirer le fichier Pas Mal.xlsm ?

Tant que tu ne joindras pas un fichier Excel allégé (avec formule) reflétant ton fichier original dans sa structure et son fonctionnement, on perds son temps à tatonner

 

[alain.raphael]

Je voulais le remplacer par celui là.....

un Fichier allégé avec erreur !!!!!

Cette fois-ci on y est...

Merci Staple.

 

[Staple1600]

Re

Apparemment, ca fonctionne avec ces modifs
et en modifiant ta formule:=SI(N3="x";"x";0)

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

 

[alain.raphael]

Merci Staple......

Grâce à ton dernier POST, j'ai vu où je péchais........

Le fichier source marche donc très bien maintenant......après de nombreuses heures de recherche.......

Merci encore....

 

[Staple1600]

Bonsoir le fil, le forum

@alain.raphael
Et par curioisté (et pour ma gouverne), tu peux préciser, stp, où cela péchais exactement,