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
2 3 4 5 6
Avatar
rthompson
Bonsoir

Avant même de regarder de plus près ta proposition
et avant que je ne l'oublie

Comment as-tu fais pour supprimer tous les espaces des noms de communes

Quand moi j'ai fais un Replace cela n'a pas fonctionné

As tantôt

Rex

PS
Pour le reste je suis encore occupé




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

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

Ben oui

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

Voici la version que j'utilise actuellement




tu ne peux utiliser la colonne C (plage nommée [EntreeCommune]) pour faire
une recherche efficace :
il y a des doublons !!!!!

il faut utiliser les colonnes L et M
après avoir nettoyé les espaces superfétatoires et car(0160)

http://www.cijoint.fr/cjlink.php?file=cj201002/cijx30boTF.xls
Avatar
michdenis
Dans la fenêtre Rechercher/Remplacer

Dans la case Rechercher : en tenant la touche Alt enfoncée à gauche
de la barre d'espacement , tu tapes, 0160... lorsque tu relâcheras
un espace sera ajouté. Dans la case remplacer, tu la laisses totalement
vide.



"rthompson" a écrit dans le message de groupe de discussion
: O$
Bonjour

OUI OUI OUI

Je sais que la petite aide ménagère dois passer faire le ménage

Je dois m'absenter quelques heures j'y travail tantôt et je te tiens au
courant

Rex


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

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
Ben non

Il me met le même message d'erreur que si j'y mets juste un espace

Il n'y a pas de données à remplacer

Et il y en a des espaces dans les cellules

Et cela même si je sélectionne toute la feuille ou une seule cellule

Bizarre, bizarre

Si tu as une idée????????


Mais pour le reste je vais faire une réponse générale dans une minute

Rex


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

Dans la fenêtre Rechercher/Remplacer

Dans la case Rechercher : en tenant la touche Alt enfoncée à gauche
de la barre d'espacement , tu tapes, 0160... lorsque tu relâcheras
un espace sera ajouté. Dans la case remplacer, tu la laisses totalement
vide.



"rthompson" a écrit dans le message de
groupe de discussion
: O$
Bonjour

OUI OUI OUI

Je sais que la petite aide ménagère dois passer faire le ménage

Je dois m'absenter quelques heures j'y travail tantôt et je te tiens au
courant

Rex


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

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
Bonsoir à tous et toutes

Mis à part le petit souci d'espace

Avec toutes les infos que j'ai pris à l'un et à l'autre
je crois pouvoir sérieusement avancer dans ce fichier

Je vous remercie tous et nous nous retrouverons certainement très bientôt

Mais en attendant je vais essayer d'avancer tout seul COMME UN GRAND


A très bientôt

Rex



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

Bonjour et merci

Cela fonctionne

MAIS
Je dois absolument m'absenter pour quelques heures

Je te réponds tout à l'heure

Rex


"Daniel.C" a écrit dans le message de news:
%
Erratum.
Lire :
Pour Rixensart (C55)
au lieu de :
Pour Rixensart (B55)
Daniel
Regarde le classeur ci-dessous. le changement de couleur se produit
quand tu entres une valeur dans les colonnes G, H ou I. Pour Rixensart
(B55), entre une valeur différente des valeurs présentes et la carte est
actualisée :

http://cjoint.com/?cdps5iRVsU

Daniel

Y a qu'à demander

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


Rex



"Daniel.C" a écrit dans le message de news:

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
Bonsoir à tous et toutes

Mis à part le petit souci d'espace

Avec toutes les infos que j'ai pris à l'un et à l'autre
je crois pouvoir sérieusement avancer dans ce fichier

Je vous remercie tous et nous nous retrouverons certainement très bientôt

Mais en attendant je vais essayer d'avancer tout seul COMME UN GRAND


A très bientôt

Rex


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

Dans la fenêtre Rechercher/Remplacer

Dans la case Rechercher : en tenant la touche Alt enfoncée à gauche
de la barre d'espacement , tu tapes, 0160... lorsque tu relâcheras
un espace sera ajouté. Dans la case remplacer, tu la laisses totalement
vide.



"rthompson" a écrit dans le message de
groupe de discussion
: O$
Bonjour

OUI OUI OUI

Je sais que la petite aide ménagère dois passer faire le ménage

Je dois m'absenter quelques heures j'y travail tantôt et je te tiens au
courant

Rex


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

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
Bonsoir à tous et toutes

Mis à part le petit souci d'espace

Avec toutes les infos que j'ai pris à l'un et à l'autre
je crois pouvoir sérieusement avancer dans ce fichier

Je vous remercie tous et nous nous retrouverons certainement très bientôt

Mais en attendant je vais essayer d'avancer tout seul COMME UN GRAND


A très bientôt

Rex


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

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
Bonsoir à tous et toutes

Mis à part le petit souci d'espace

Avec toutes les infos que j'ai pris à l'un et à l'autre
je crois pouvoir sérieusement avancer dans ce fichier

Je vous remercie tous et nous nous retrouverons certainement très bientôt

Mais en attendant je vais essayer d'avancer tout seul COMME UN GRAND


A très bientôt

Rex



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

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



Avatar
Daniel.C
J'ai eu un cas semblable ce matin. Ca ne s'exécutait pas avec Excel
mais une macro en venait à bout :

Sub Nettoyer()
Dim c As Range
Application.ScreenUpdating = False
For Each c In ActiveSheet.UsedRange
c.Value = WorksheetFunction.Clean(c.Value)
c.Value = WorksheetFunction.Trim(c.Value)
Next c
Application.ScreenUpdating = True
End Sub

Daniel

Ben non

Il me met le même message d'erreur que si j'y mets juste un espace

Il n'y a pas de données à remplacer

Et il y en a des espaces dans les cellules

Et cela même si je sélectionne toute la feuille ou une seule cellule

Bizarre, bizarre

Si tu as une idée????????


Mais pour le reste je vais faire une réponse générale dans une minute

Rex


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

Dans la fenêtre Rechercher/Remplacer

Dans la case Rechercher : en tenant la touche Alt enfoncée à gauche
de la barre d'espacement , tu tapes, 0160... lorsque tu relâcheras
un espace sera ajouté. Dans la case remplacer, tu la laisses totalement
vide.



"rthompson" a écrit dans le message de
groupe de discussion
: O$
Bonjour

OUI OUI OUI

Je sais que la petite aide ménagère dois passer faire le ménage

Je dois m'absenter quelques heures j'y travail tantôt et je te tiens au
courant

Rex


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

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
Modeste
Bonsour® rthompson avec ferveur ;o))) vous nous disiez :

Avec toutes les infos que j'ai pris à l'un et à l'autre
je crois pouvoir sérieusement avancer dans ce fichier

Je vous remercie tous et nous nous retrouverons certainement très
bientôt

Mais en attendant je vais essayer d'avancer tout seul COMME UN GRAND



pour t'éviter la mise en place de shapes représentant le contour des communes
voici une alternative ( à toi de continuer de l'enrichir)
validée
- avec ma proc : click sur la shape de la commune
- avec la proc : WorkBookChange de Denis

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

@+
Avatar
rthompson
Bonjour Daniel

Avec tellemnt de retard que le rouge de la honte me monte au visage

Permet moi de te dire


MERCI

Ta petite macro fait merveille


A bientôt

Rex


"Daniel.C" a écrit dans le message de news:

J'ai eu un cas semblable ce matin. Ca ne s'exécutait pas avec Excel mais
une macro en venait à bout :

Sub Nettoyer()
Dim c As Range
Application.ScreenUpdating = False
For Each c In ActiveSheet.UsedRange
c.Value = WorksheetFunction.Clean(c.Value)
c.Value = WorksheetFunction.Trim(c.Value)
Next c
Application.ScreenUpdating = True
End Sub

Daniel

Ben non

Il me met le même message d'erreur que si j'y mets juste un espace

Il n'y a pas de données à remplacer

Et il y en a des espaces dans les cellules

Et cela même si je sélectionne toute la feuille ou une seule cellule

Bizarre, bizarre

Si tu as une idée????????


Mais pour le reste je vais faire une réponse générale dans une minute

Rex


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

Dans la fenêtre Rechercher/Remplacer

Dans la case Rechercher : en tenant la touche Alt enfoncée à gauche
de la barre d'espacement , tu tapes, 0160... lorsque tu relâcheras
un espace sera ajouté. Dans la case remplacer, tu la laisses totalement
vide.



"rthompson" a écrit dans le message de
groupe de discussion
: O$
Bonjour

OUI OUI OUI

Je sais que la petite aide ménagère dois passer faire le ménage

Je dois m'absenter quelques heures j'y travail tantôt et je te tiens au
courant

Rex


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

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









2 3 4 5 6