Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel Coloriage d'objet dessin

Coloriage d'objet dessin

52 réponses
Avatar
rthompson
Bonjour à toutes et tous

Je suis à nouveau plongé dans mon désir de créer une carte active
(Eh oui je sais, je suis con mais persistant)

Je voudrais savoir si il y a moyen de changer la couleur d'un objet suivant
la valeur d'une cellule


J'explique


Une forme dessinnée et nommée Rixensart (comme par hasard)
Cette forme est placée sur une feuille nommée Wallonie (encore un hasard)

Sur une feuille nommée ENTREE (mais quelle immagination!) j'ai des données
dans le style

Communes Revendeurs Utilisateurs Tableaux
Rixensart 1 5
14
etc 4 25
53


Et je voudrais que la forme "Rixensart" soit verte si on est à moins de 10,
rouge si on est entre 11 et 20
Bleu si on est entre 21 et 30

Le tout par VBA, (j'en ai bien peur) et mise à jour par bouton
Le dernier truc je pourrais le faire

Mais c'est la création des couleurs qui me chiffonne

C'est pas possible, hein? Mais si! (j'ai demandé à la SNCF, mais il m'ont
dit que cette pub était périmé)


A bientôt

Rex
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2 3 4 5
Avatar
rthompson
Voici le fichier

http://www.cijoint.fr/cjlink.php?file=cj201002/cijcoSHW79.xls

Rex

"Modeste" a écrit dans le message de news:

Bonsour® rthompson avec ferveur ;o))) vous nous disiez :

xxxxxxxxxxxxxxxxxxxxxxx
Sheets("Wallonie").Shapes("Rixensart").Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 5
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Et ce que je voudrais, ce sont deux astuces
Une pour que la valeur de la couleur soit celle afficher dans une
cellule (D5 dans ce cas-ci)
Deuxième astuces
Comment faire pour que cela se passe pour toutes les formes de ma
feuille? En prenant bien sur le chiffre de couleur dans la colonne D
sur la même ligne que le nom de la forme
Sur une feuille nommée ENTREE (mais quelle immagination!) j'ai des
données dans le style

Communes Revendeurs Utilisateurs Tableaux
Rixensart 1 5 14
etc 4 25 53





1 - Feuilles ENTREE
nommer les plages Communes et Tableaux
2 - Feuille WALLONIE
associer aux différentes shapes souhaitées la macro ci-dessous

Option Explicit

Sub ColorShape()
Dim myshape As Shape
Dim selectedshape As String
Dim myindex As Long
'------ retrieve selected shape name
selectedshape = Application.Caller
' ------retrieve current line from Communes
myindex = Application.Index([tableaux], Application.Match(selectedshape,
[Communes], 0), 1)
MsgBox selectedshape & Chr(10) & myindex & " Tableaux"
'------- qualification of the correct shape to avoid physical selection
Set myshape = Sheets("Wallonie").Shapes(selectedshape)
With myshape.Fill
.Visible = msoTrue
.Solid
'------- immediate IF
'------- 10 is lower value, 11 is schemeColor for green
'------- 20 is higher value, 10 is schemecolor for red, 12 is schemecolor
for blue
.ForeColor.SchemeColor = IIf(myindex < 10, 11, IIf(myindex < 20, 10,
12))
End With

End Sub
Avatar
rthompson
Et voici le fichier

http://www.cijoint.fr/cjlink.php?file=cj201002/cijcoSHW79.xls

Rex


"FFO" a écrit dans le message de news:

Salut à toi

1° astuce :

Selection.ShapeRange.Fill.ForeColor.SchemeColor = Range("D5")


2° astuce

For i = 1 To Sheets("Wallonie").Shapes.Count
Sheets("Wallonie").Shapes(i).Select
On Error Resume Next
Ligne = 0
Ligne = Cells.Find(What:=Sheets("Wallonie").Shapes(i).Name,
LookIn:=xlValues, LookAt:=xlWhole).Row
If Ligne <> 0 Then
Selection.ShapeRange.Fill.ForeColor.SchemeColor = Range("D" & Ligne)
Else
MsgBox("Le nom " & Sheets("Wallonie").Shapes(i).Name & " est inexistant")
End If
Next

Celà devrait faire

Dis moi !!!!!!



Avatar
rthompson
Bonjour et merci

Je comprends un peu mieux ce que tu me montres
Mais ce n'est pas le but recherché

Je gardes ton fichier, il me servira j'en suis certains

Merci

J'ai posté mon fichier, tu l'as vu?

Rex



"Modeste" a écrit dans le message de news:

Bonsour® rthompson avec ferveur ;o))) vous nous disiez :

xxxxxxxxxxxxxxxxxxxxxxx
Sheets("Wallonie").Shapes("Rixensart").Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 5
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Et ce que je voudrais, ce sont deux astuces
Une pour que la valeur de la couleur soit celle afficher dans une
cellule (D5 dans ce cas-ci)
Deuxième astuces
Comment faire pour que cela se passe pour toutes les formes de ma
feuille? En prenant bien sur le chiffre de couleur dans la colonne D
sur la même ligne que le nom de la forme
Sur une feuille nommée ENTREE (mais quelle immagination!) j'ai des
données dans le style

Communes Revendeurs Utilisateurs Tableaux
Rixensart 1 5 14
etc 4 25 53







http://www.cijoint.fr/cjlink.php?file=cj201002/cijO5XxIOc.xls


1 - Feuilles ENTREE
nommer les plages Communes et Tableaux
2 - Feuille WALLONIE
associer aux différentes shapes souhaitées la macro ci-dessous

Option Explicit

Sub ColorShape()
Dim myshape As Shape
Dim selectedshape As String
Dim myindex As Long
'------ retrieve selected shape name
selectedshape = Application.Caller
' ------retrieve current line from Communes
myindex = Application.Index([tableaux],
Application.Match(selectedshape, [Communes], 0), 1)
MsgBox selectedshape & Chr(10) & myindex & " Tableaux"
'------- qualification of the correct shape to avoid physical
selection
Set myshape = Sheets("Wallonie").Shapes(selectedshape)
With myshape.Fill
.Visible = msoTrue
.Solid
'------- immediate IF
'------- 10 is lower value, 11 is schemeColor for green
'------- 20 is higher value, 10 is schemecolor for red, 12 is
schemecolor for blue
.ForeColor.SchemeColor = IIf(myindex < 10, 11, IIf(myindex <
20, 10, 12))
End With

End Sub


Avatar
Modeste
Bonsour® rthompson avec ferveur ;o))) vous nous disiez :

Ben cette fois-ci j'y comprends rien
Alors que ce que je cherche à faire et d'avoir une carte de Wallonie
dont les zones sont coloriées
en fonctions de leurs chiffres

Donc une macro générale affectée à un bouton


alors simplement :

Sub ColorShape()
Dim myindex As Long
Dim c As Shape
For Each c In Sheets("Wallonie").Shapes
myindex = Application.Index([tableaux], Application.Match(c.Name, [Communes], 0), 1)
With c.Fill
.Visible = msoTrue
.Solid
'------- immediate IF
'------- 10 is lower value, 11 is schemeColor for green
'------- 20 is higher value, 10 is schemecolor for red, 12 is schemecolor for blue
.ForeColor.SchemeColor = IIf(myindex < 10, 11, IIf(myindex < 20, 10, 12))
End With
Next

End Sub
Avatar
Daniel.C
Quelle est la plage de cellules servant au coloriage ?

Et voici le fichier

http://www.cijoint.fr/cjlink.php?file=cj201002/cijcoSHW79.xls

Rex


"FFO" a écrit dans le message de news:

Salut à toi

1° astuce :

Selection.ShapeRange.Fill.ForeColor.SchemeColor = Range("D5")


2° astuce

For i = 1 To Sheets("Wallonie").Shapes.Count
Sheets("Wallonie").Shapes(i).Select
On Error Resume Next
Ligne = 0
Ligne = Cells.Find(What:=Sheets("Wallonie").Shapes(i).Name,
LookIn:=xlValues, LookAt:=xlWhole).Row
If Ligne <> 0 Then
Selection.ShapeRange.Fill.ForeColor.SchemeColor = Range("D" & Ligne)
Else
MsgBox("Le nom " & Sheets("Wallonie").Shapes(i).Name & " est inexistant")
End If
Next

Celà devrait faire

Dis moi !!!!!!





Avatar
Modeste
Bonsour® rthompson avec ferveur ;o))) vous nous disiez :

Voici le fichier

http://www.cijoint.fr/cjlink.php?file=cj201002/cijcoSHW79.xls



;o)))
beaucoup de boulot (creation des shapes et de manques ....
les noms de communes ne sont pas propres (présence d'espaces et car(0160))
la shape Estampuis est crée mais il n'y a pas de commune Estampuis

Sub ColorShape()
Dim myindex As Long
Dim c As Shape
On Error GoTo suivant
For Each c In Sheets("Wallonie").Shapes
myindex = Application.Index([Totcommunes], Application.Match(UCase(c.Name), [Communes], 0), 1)
With c.Fill
.Visible = msoTrue
.Solid
'------- immediate IF
'------- 10 is lower value, 11 is schemeColor for green
'------- 20 is higher value, 10 is schemecolor for red, 12 is schemecolor for blue
.ForeColor.SchemeColor = IIf(myindex < 10, 11, IIf(myindex < 20, 10, 12))
End With
suivant:

Next

End Sub
Avatar
rthompson
Bonjour

Bien vu!!

Je viens de créer deux nouvelles plages

EntreeListeCommuneTotal pour les chiffres
EntreeListeCommuneTotal pour les noms des communes


Rex



"Daniel.C" a écrit dans le message de news:
%
Quelle est la plage de cellules servant au coloriage ?

Et voici le fichier

http://www.cijoint.fr/cjlink.php?file=cj201002/cijcoSHW79.xls

Rex


"FFO" a écrit dans le message de news:

Salut à toi

1° astuce :

Selection.ShapeRange.Fill.ForeColor.SchemeColor = Range("D5")


2° astuce

For i = 1 To Sheets("Wallonie").Shapes.Count
Sheets("Wallonie").Shapes(i).Select
On Error Resume Next
Ligne = 0
Ligne = Cells.Find(What:=Sheets("Wallonie").Shapes(i).Name,
LookIn:=xlValues, LookAt:=xlWhole).Row
If Ligne <> 0 Then
Selection.ShapeRange.Fill.ForeColor.SchemeColor = Range("D" & Ligne)
Else
MsgBox("Le nom " & Sheets("Wallonie").Shapes(i).Name & " est
inexistant")
End If
Next

Celà devrait faire

Dis moi !!!!!!









Avatar
Daniel.C
Tu peux renvoyer le classeur ?
Daniel

Bonjour

Bien vu!!

Je viens de créer deux nouvelles plages

EntreeListeCommuneTotal pour les chiffres
EntreeListeCommuneTotal pour les noms des communes


Rex



"Daniel.C" a écrit dans le message de news:
%
Quelle est la plage de cellules servant au coloriage ?

Et voici le fichier

http://www.cijoint.fr/cjlink.php?file=cj201002/cijcoSHW79.xls

Rex


"FFO" a écrit dans le message de news:

Salut à toi

1° astuce :

Selection.ShapeRange.Fill.ForeColor.SchemeColor = Range("D5")


2° astuce

For i = 1 To Sheets("Wallonie").Shapes.Count
Sheets("Wallonie").Shapes(i).Select
On Error Resume Next
Ligne = 0
Ligne = Cells.Find(What:=Sheets("Wallonie").Shapes(i).Name,
LookIn:=xlValues, LookAt:=xlWhole).Row
If Ligne <> 0 Then
Selection.ShapeRange.Fill.ForeColor.SchemeColor = Range("D" & Ligne)
Else
MsgBox("Le nom " & Sheets("Wallonie").Shapes(i).Name & " est inexistant")
End If
Next

Celà devrait faire

Dis moi !!!!!!











Avatar
rthompson
Bonjour

Voici ton code avec mes plages nommées

xxxxxxxxxxxxxxxxxxxxxxxxxx
Sub ColorShape()
Dim myindex As Long
Dim c As Shape
For Each c In Sheets("Wallonie").Shapes
myindex = Application.Index([EntreeListeCommuneTotal],
Application.Match(c.Name, [EntreeListeCommune], 0), 1)
With c.Fill
.Visible = msoTrue
.Solid
'------- immediate IF
'------- 10 is lower value, 11 is schemeColor for green
'------- 20 is higher value, 10 is schemecolor for red, 12 is schemecolor
for blue
.ForeColor.SchemeColor = IIf(myindex < 10, 11, IIf(myindex < 20, 10,
12))
End With
Next

End Sub
xxxxxxxxxxxxxxxxxxxxxxxxxxxxx

Et il me met Error 13 Type Mismatch

Que cherche-t-il?

Rex

"Modeste" a écrit dans le message de news:

Bonsour® rthompson avec ferveur ;o))) vous nous disiez :

Ben cette fois-ci j'y comprends rien
Alors que ce que je cherche à faire et d'avoir une carte de Wallonie
dont les zones sont coloriées
en fonctions de leurs chiffres

Donc une macro générale affectée à un bouton


alors simplement :

Sub ColorShape()
Dim myindex As Long
Dim c As Shape
For Each c In Sheets("Wallonie").Shapes
myindex = Application.Index([tableaux], Application.Match(c.Name,
[Communes], 0), 1)
With c.Fill
.Visible = msoTrue
.Solid
'------- immediate IF
'------- 10 is lower value, 11 is schemeColor for green
'------- 20 is higher value, 10 is schemecolor for red, 12 is schemecolor
for blue
.ForeColor.SchemeColor = IIf(myindex < 10, 11, IIf(myindex < 20, 10,
12))
End With
Next

End Sub
Avatar
FFO
Rebonjour à toi

Tu demandes :
Comment faire pour que cela se passe pour toutes les formes de ma feuille?
En prenant bien sur le chiffre de couleur dans la colonne D sur la même
ligne que le nom de la forme


Le nom de la form est donc dans une cellule dont on doit déterminer la ligne

Je te propose :

Ligne = Cells.Find(What:=Sheets("Wallonie").Shapes(i).Name,
LookIn:=xlValues, LookAt:=xlWhole).Row


Je cherche dans la feuille le nom de la Shape
(What:=Sheets("Wallonie").Shapes(i).Name) je regarde les valeurs des cellules
(LookIn:=xlValues) et dans leur entier (LookAt:=xlWhole)
Je récupère ainsi le numéro de la ligne :

Ligne = Cells.Find(What:=Sheets("Wallonie").Shapes(i).Name,
LookIn:=xlValues, LookAt:=xlWhole).Row

Tu demandes :

Comment faire pour que cela se passe pour toutes les formes de ma feuille?

Je te propose:
d'effectuer la recherche des lignes sur l'ensemble des Shape avec la
variable i :

For i = 1 To Sheets("Wallonie").Shapes.Count

Ce qui donne le code au final

'Toutes les Shape
For i = 1 To Sheets("Wallonie").Shapes.Count
'Selection de la Shape
Sheets("Wallonie").Shapes(i).Select
On Error Resume Next
Ligne = 0
'Determination de la ligne de la cellule qui porte le nom de la Shape
Ligne = Cells.Find(What:=Sheets("Wallonie").Shapes(i).Name,
LookIn:=xlValues, LookAt:=xlWhole).Row
'Si la cellule est trouvé je donne la couleur à la Shape en fonction de la
valeur colonne D de la même ligne
If Ligne <> 0 Then
Selection.ShapeRange.Fill.ForeColor.SchemeColor = Range("D" & Ligne)
'Sinon j'informe de l'absence du nom de la Shape dans la feuille
Else
MsgBox("Le nom " & Sheets("Wallonie").Shapes(i).Name & " est inexistant")
End If
Next


Est ce plus claire ainsi

Je crois avoir scrupuleusement répondu à ton cahier des charges

Dans la négative merci de m'expliquer

Dans l'attente de te lire
1 2 3 4 5