XL 2019 Colorer des shapes en récupérant la couleur d'une cellule

[ruliann]

bonjour

Dans l'onglet "Animation" du fichier ci-joint (voir ce lien car ne passe pas en PJ), je cherche à colorer (remplissage) les shapes en reprenant la couleur de la cellule située en C26 de chaque onglet correspondant au nom de la shape en question.

Par exemple :

• pour la forme Th1, je souhaite appliquer la couleur de la cellule C26 de l'onglet Th1
• pour la forme Th2, je souhaite appliquer la couleur de la cellule C26 de l'onglet Th2
• pour la forme Th3, je souhaite appliquer la couleur de la cellule C26 de l'onglet Th3
• etc...

Il faudrait que toutes les formes se colorent en même temps avec leur couleur respective.

Une fois que chaque shape a été colorée par la couleur de la cellule C26, je souhaite faire changer la couleur de tous les shapes en appliquant cette fois la couleur de D26, puis, recommencer la manip avec la couleur de E26, etc...

Mon idée est de créer une sorte d'animation visuelle, une sorte de gif. (je réalise une cartographie de locaux et j'aimerais avoir une évolution visuelle).

Si la durée de remplissage des formes par chaque couleur (C26, puis D26, puis E26...) était paramétrable ce serait bien. Ca me semble impossible de colorer dans le même timing plusieurs shapes, car je me dis qu'une macro traitera tjs les instructions les unes à la suite des autres...

Qu'est que vous pourriez me conseiller?

 

[sylvanu]

Bonjour Ruliann,

Qu'est que vous pourriez me conseiller?

En tout premier un petit fichier test, ne serait ce pour éviter qu'on se retape ce fichier qui ne serait qu'approximatif.
NB: Je parlais d'un fichier représentatif. Votre fichier est incompréhensible vu de l'extérieur.
- Je n'ai trouvé aucun Shape
- La cellule C26 de l'onglet Th1 vaut 20.1, ce n'est pas la définition d'une couleur.
- De plus ces cellules sont blanches, quelle couleur appliquer ?

 

[sylvanu]

Re,
Une PJ à tester avec des shapes et comme dans l'énoncé :

• pour la forme Th1, je souhaite appliquer la couleur de la cellule C26 de l'onglet Th1
• pour la forme Th2, je souhaite appliquer la couleur de la cellule C26 de l'onglet Th2
• pour la forme Th3, je souhaite appliquer la couleur de la cellule C26 de l'onglet Th3

Il vous faut activer les macros.

 

[ruliann]

@sylvanu : vraiment navré, je me suis trompé de fichier dans le lien que j'ai donné... J'ai rectifié les liens, voici le fichier . Dites moi si cela ne vous est pas clair pour autant

Dans votre exemple, les couleurs s'affichent en même temps donc mon inquiétude n'était pas fondée.

 

[sylvanu]

@ruliann
Je réitère le problème :

La cellule C26 de l'onglet Th1 vaut 20.1, ce n'est pas la définition d'une couleur.

Pour Th1 la colonne C26:C46 va de 17.1 à 22.5
Donc je suppose que pour les couleurs, il faut référencé les couleurs au prorata du dégradé ThMoy de la feuille Dégradé ?
Et que pour les valeurs nulles on laisse blanc ?

 

[sylvanu]

Toujours pas de réponse ???

Un unique essai en PJ et mes déductions arbitraires à mes questions, et avec cette macro :

Sub MiseEnCouleurs()
Dim C%, Cmax%, N%, Ligne%, Couleur
Set PlageCoul = Sheets("Dégradé").[Q4:Q20]  ' Plage index températures
Cmax = 98: C = 3                            ' Début colonne C, fin colonne 98
While C < Cmax
    [C1] = (0.25 * C + 5.25) / 24           ' Calcul de l'heure pour affichage
    For N = 1 To 23                                                     ' Pour tous les shapes
        Temp = Sheets("Th" & N).Cells(26, C)                            ' Acquisition température
        Ligne = 3 + Application.Match(Round(Temp), PlageCoul, 1)        ' Calcul ligne dans plage temp
        Couleur = Sheets("Dégradé").Cells(Ligne, "T").Interior.Color    ' Acquisition couleur de temp
        ActiveSheet.Shapes("ZoneTexte " & N).Fill.ForeColor.RGB = Couleur ' Mise en couleur du shape
    Next N
    C = C + 1                                                           ' Prochaine colonne
    Application.Wait (Now + TimeValue("00:00:01"))                      ' Attente 1 seconde entre deux steps
Wend
[C1] = ""                                                               ' On vide l'heure
For N = 1 To 23                                                         ' Tous les shapes en blanc.
    ActiveSheet.Shapes("ZoneTexte " & N).Fill.ForeColor.RGB = vbWhite
Next N
End Sub

https://www.cjoint.com/c/MIsjAb5NnD8

NB: La prochaine fois faites un fichier test représentatif qui tient sous 1Mo. Cela évite de livrer par un serveur tiers. Ces fichiers sont détruits généralement sous un temps court, et les futurs lecteurs n'y auront plus accès.

NB2 : Bien évidemment dans la PJ j'ai bidouillé les températures pour en faire un fichier représentatif, car avec une seule temps l'animation n'était guère visuelle.

 

[ruliann]

@ruliann
Je réitère le problème :

Pour Th1 la colonne C26:C46 va de 17.1 à 22.5
Donc je suppose que pour les couleurs, il faut référencé les couleurs au prorata du dégradé ThMoy de la feuille Dégradé ?
Et que pour les valeurs nulles on laisse blanc ?

j'étais parti en train de trifouiller ton code pour comprendre. Alors, pour les couleurs de la forme Th1 (rectangle Th1) qui est dans l'onglet "Animation", il faut prendre successivement les couleurs qui sont en C26 de l'onglet Th1, puis prendre la couleur de D26 de l'onglet Th1, puis prendre E26 de l'onglet Th1, etc...

Pour le mapping de l'onglet Th1, j'ai utilisé les couleurs de l'onglet "Dégradé", avec le dégradé "bureaux".

Je regarde la PJ que tu as fait suivre

 

[ruliann]

Toujours pas de réponse ???

Un unique essai en PJ et mes déductions arbitraires à mes questions, et avec cette macro :

Sub MiseEnCouleurs()
Dim C%, Cmax%, N%, Ligne%, Couleur
Set PlageCoul = Sheets("Dégradé").[Q4:Q20]  ' Plage index températures
Cmax = 98: C = 3                            ' Début colonne C, fin colonne 98
While C < Cmax
    [C1] = (0.25 * C + 5.25) / 24           ' Calcul de l'heure pour affichage
    For N = 1 To 23                                                     ' Pour tous les shapes
        Temp = Sheets("Th" & N).Cells(26, C)                            ' Acquisition température
        Ligne = 3 + Application.Match(Round(Temp), PlageCoul, 1)        ' Calcul ligne dans plage temp
        Couleur = Sheets("Dégradé").Cells(Ligne, "T").Interior.Color    ' Acquisition couleur de temp
        ActiveSheet.Shapes("ZoneTexte " & N).Fill.ForeColor.RGB = Couleur ' Mise en couleur du shape
    Next N
    C = C + 1                                                           ' Prochaine colonne
    Application.Wait (Now + TimeValue("00:00:01"))                      ' Attente 1 seconde entre deux steps
Wend
[C1] = ""                                                               ' On vide l'heure
For N = 1 To 23                                                         ' Tous les shapes en blanc.
    ActiveSheet.Shapes("ZoneTexte " & N).Fill.ForeColor.RGB = vbWhite
Next N
End Sub

https://www.cjoint.com/c/MIsjAb5NnD8

NB: La prochaine fois faites un fichier test représentatif qui tient sous 1Mo. Cela évite de livrer par un serveur tiers. Ces fichiers sont détruits généralement sous un temps court, et les futurs lecteurs n'y auront plus accès.

NB2 : Bien évidemment dans la PJ j'ai bidouillé les températures pour en faire un fichier représentatif, car avec une seule temps l'animation n'était guère visuelle.

Wooh! ca à l'air assez génial ce que tu as fait.

Faut juste que je m'assure d'avoir été suffisamment clair avec les couleurs qui sont à utiliser, mais le résultat est top

Je mets deux screenshot qui montrent que pour la forme Th1, il y aura 96 changements de couleurs pour le Jour1, puis 96 autres changements de couleurs pour le Jour 2, etc... soit au total 2208 changements de couleurs pour le rectangle Th1.

Dis moi si c'est pas assez clair, et encore merci pour ton aide, c'est top!

j'étais parti en train de trifouiller ton code pour comprendre. Alors, pour les couleurs il faut prendre celles qui sont en C26 de l'onglet Th1, puis prendre la couleur de D26 de l'onglet Th1, puis prendre E26 de l'onglet Th1, etc...

Pour le mapping de l'onglet Th1, j'ai utilisé les couleurs de l'onglet "Dégradé", avec le dégradé "bureaux".

Je regarde la PJ que tu as fait suivre

 

[sylvanu]

C'est un jeu de devinettes.
Seule la ligne 26 était à traiter.
Maintenant c'est toutes les lignes. Et il faut savoir quelle ligne on doit traiter .... donc trouver un système ...
A chaque fois on recommence le travail.

Vous avez le code tout fait .
Vous faites une liste déroulante pour les jours qui vous donnera la ligne à traiter.
Et vous remplacez le 26 par la bonne ligne calculée dans :

Temp = Sheets("Th" & N).Cells(26, C)

Moi je ne refait pas le travail pour la troisième fois.

 

[ruliann]

ok, pas certain d'y arriver mais merci pour votre aide.

 

[sylvanu]

La prochaine fois faites un fichier test représentatif qui tient sous 1Mo. Cela évite de livrer par un serveur tiers. Ces fichiers sont détruits généralement sous un temps court, et les futurs lecteurs n'y auront plus accès.

Comme je suppose que vous ne livrerez pas une version allégée pour les futurs lecteurs, j'en ai fait une qui suffit amplement pour traiter le problème, le reste est inutile.
Tant qu'à faire j'ai rajouté le choix du jour dont vous pourrez vous inspirer.

 

[ruliann]

Pour que les autres lecteurs s'y retrouve, je peux déjà reformuler mon besoin ci-dessous :


Je cherche à réaliser une cartographie de locaux et j'aimerais avoir une évolution visuelle des températures. Mon idée est de créer une sorte d'animation de l'évolution de la température, 1/4 d'heure par 1/4 d'heure (vu que je mesure la température tous les 1/4 d'heure) en utilisant des couleurs.


Dans l'onglet "Animation" du fichier ci-joint, je cherche donc à colorer (remplissage) des formes shapes (Th1, Th2, Th3, Th4....Th23, Ext1, et Ext2) en reprenant la couleur de cellules situées sur d'autres onglets.

Par exemple :

> Pour la forme Th1 de l'onglet "Animation" :

• je souhaite appliquer la couleur de la cellule C26 de l'onglet Th1
• puis, j'applique à la forme Th1 la couleur de la cellule D26 de l'onglet Th1
• puis, j'applique à la forme Th1 la couleur de la cellule E26 de l'onglet Th1
• puis, j'applique à la forme Th1 la couleur de la cellule F26 de l'onglet Th1
• et ainsi de suite..... jusqu'à la couleur de la cellule CT26 de l'onglet Th1....

maintenant que la ligne 26 est traitée, je continue avec les couleurs de la ligne 27 : j'applique à la forme Th1 la couleur de la cellule C27 de l'onglet Th1

• puis, j'applique à la forme Th1 la couleur de la cellule D27 de l'onglet Th1
• puis, j'applique à la forme Th1 la couleur de la cellule E27 de l'onglet Th1
• puis, j'applique à la forme Th1 la couleur de la cellule F27 de l'onglet Th1

maintenant que la ligne 27 est traitée à son tour, je continue avec les couleurs de la ligne 28 : j'applique à la forme Th1 la couleur de la cellule C28 de l'onglet Th1

• puis, j'applique à la forme Th1 la couleur de la cellule D28 de l'onglet Th1
• puis, j'applique à la forme Th1 la couleur de la cellule E28 de l'onglet Th1
• puis, j'applique à la forme Th1 la couleur de la cellule F28 de l'onglet Th1

et ainsi de suite......jusqu'à la ligne 46 et la couleur de la cellule CT46

> Pour la forme Th2 de l'onglet "Animation :

• je souhaite appliquer la couleur de la cellule C26 de l'onglet Th2
• puis, j'applique à la forme Th2 la couleur de la cellule D26 de l'onglet Th2
• puis, j'applique à la forme Th2 la couleur de la cellule E26 de l'onglet Th2
• puis, j'applique à la forme Th2 la couleur de la cellule F26 de l'onglet Th2
• et ainsi de suite..... jusqu'à la couleur de la cellule CT26 de l'onglet Th2....

maintenant que la ligne 26 est traitée, je continue avec les couleurs de la ligne 27 : j'applique à la forme Th2 la couleur de la cellule C27 de l'onglet Th1

• puis, j'applique à la forme Th2 la couleur de la cellule D27 de l'onglet Th2
• puis, j'applique à la forme Th2 la couleur de la cellule E27 de l'onglet Th2
• puis, j'applique à la forme Th2 la couleur de la cellule F27 de l'onglet Th2

maintenant que la ligne 27 est traitée à son tour, je continue avec les couleurs de la ligne 28 : j'applique à la forme Th2 la couleur de la cellule C28 de l'onglet Th1

• puis, j'applique à la forme Th2 la couleur de la cellule D28 de l'onglet Th2
• puis, j'applique à la forme Th2 la couleur de la cellule E28 de l'onglet Th2
• puis, j'applique à la forme Th2 la couleur de la cellule F28 de l'onglet Th2

et ainsi de suite......jusqu'à la ligne 46 et la couleur de la cellule CT46

> Pour la forme Th3 de l'onglet "Animation :

• je souhaite appliquer la couleur de la cellule C26 de l'onglet Th3
• puis, j'applique à la forme Th3 la couleur de la cellule D28 de l'onglet Th3
• etc...

> Le principe est le même pour Th4, Th5, Th6....jusqu'à la forme Th23.

Pour les 2 formes Ext1 et Ext2 qui sont sur l'onglet "Animations", elle sont aussi à colorer en suivant le même principe et en utilisant respectivement les couleurs des onglets Ext1 et Ext2.

Pour terminer, iI faudrait que toutes les formes (Th1, Th2, Th3........Th23, Ext1, Ext2) se colorent en même temps avec leur couleur respective.

 

[ruliann]

Comme je suppose que vous ne livrerez pas une version allégée pour les futurs lecteurs, j'en ai fait une qui suffit amplement pour traiter le problème, le reste est inutile.
Tant qu'à faire j'ai rajouté le choix du jour dont vous pourrez vous inspirer.

Je veux bien livrer une version allégée, mais qu'est ce que vous trouvez inutile sur le fichier original?

 

[sylvanu]

Regardez ma PJ du post #11. La version allégée est déjà livrée.
Un fichier test représentatif est un fichier dont seules les données utiles sont présentes pour traiter le problème.
L'intitulé du fil est "Colorer des shapes en récupérant la couleur d'une cellule", donc dans ma PJ j'ai supprimé tout ce qui ne concernait pas cet item.
D'où ma macro Nettoie :

Sub Nettoie()
' Nettoie le dossier pour être inférieur à 1Mo et être livrable sur XLD
' A enregistrer en xlsb pour réduire encore la taille.
For i = 1 To 23
    Sheets("Th" & i).[C2:CT22].ClearContents
    Sheets("Th" & i).[C27:CT46] = Sheets("Th" & i).[C27:CT46].Value
Next i
End Sub

Et on passe ainsi de 2.7Mo à 509ko donc livrable en PJ sur XLD. la durée de vie de cette PJ est bien supérieure à la durée de vie sur un serveur tiers. Et donc le lecteur y a accès.
Et ce fichier est suffisant pour décrire les mécanismes utilisés pour faire une animation.
C'est à vous ensuite de ré adapter ces mécanismes à votre fichier réel.

D'où la partie de notre charte s'y référant ( Lien )

Les problèmes liés à la fourniture de liens vers des fichiers téléchargeables en dehors du forum sont les suivants : les liens expirent souvent après une certaine durée, de nombreux utilisateurs ne peuvent pas télécharger de fichiers à partir de sites de partage de fichiers en raison de restrictions de sécurité réseau, de nombreux utilisateurs hésitent à télécharger des fichiers pour des raisons de sécurité personnelle et les fonctionnalités de recherche du forum ne fonctionnent pas.

 

[ruliann]

Comme je suppose que vous ne livrerez pas une version allégée pour les futurs lecteurs, j'en ai fait une qui suffit amplement pour traiter le problème, le reste est inutile.
Tant qu'à faire j'ai rajouté le choix du jour dont vous pourrez vous inspirer.

@sylvanu
que je comprenne : dans votre code, vous ne cherchez donc pas à récupérer le code couleur RGB de chaque cellule sur la plage C26:CT46 des onglets Th1 à Th23 (couleurs qui étaient issues d'une MFC dans mon fichier d'origine), mais vous vous référez au chiffre contenu dans la cellule (la T°c) qui lui-même renvoi au dégradé?

Ensuite, j'ai un problème sur l'onglet Animation j'ai deux rectangles dénommés Ext1 et Ext2. Ces deux rectangles ne sont pas traités par la ligne de code ci-dessous. Ils doivent être colorés selon des couleurs qui se trouvent dans l'onglet Ext1 et dans l'onglet Ext2.

Je rajoute donc l'onglet Ext1 et l'onglet Ext2 au fichier.

Y a-t-il une possibilité de prendre en considération ce besoin en modifiant cette ligne? ou faut-il que je renomme tous mes onglets Th1, Thx..., et tous mes shapes Th1, Thx... (en gros que je renomme Ext1 par Th1 et Ext2 par Th2... et tout décaler mes appellations actuelles)

Temp = Sheets("Th" & N).Cells(LigneJour, C)                     ' Acquisition température