XL 2021 Colorer avec condition de temps

matlatarte · Vendredi à 17:13

Bonjour,

j'aimerai colorer un objet ou autre chose de manière conditionnée au temps:
lorsque je clique sur une macro/bouton j'aimerai qu'un objet soit rouge par exemple de 5 à 6 s (pdt 1s donc) après avoir cliqué sur le bouton et ensuite qu'il redevienne comme avant.

la condition 5 à 6 seconde sera variable en fct d'une valeur de cellule (des fois de 0 à 2s, des fois de 10s à 30s ect..)

Je ne vois pas comment m'y prendre ? Est ce possible ?

Merci de votre aide !

sylvanu · Vendredi à 17:30

Bonjour matlatarte,
Je pense que seule une solution par macro VBA puisse convenir. Acceptez vous le VBA ?
D'autre part, lorsque la cellule ou l'objet est rouge, voulez vous conserver la main ?
( c'est à dire avoir la possibilité de continuer à travailler sur votre feuille lorsque l'objet est rouge )
Pour finir, un petit fichier test serait le bienvenu.

matlatarte · Vendredi à 18:00

Oui VBA bien sûr. Oui j'aimerai conserver la main, après si plus simple sans, pas bien grave car le changement temporaire de couleur ne doit pas dépasser 2 secondes... merci !

jurassic pork · Vendredi à 18:03

Hello,
un truc vite fait sur le gaz en utilisant Application.OnTime :

VB:

Sub LaunchMacroAfterDelay()
    Dim RunTime As Date, Start, Fin, DelayTime
    Start = 5
    DelayTime = 1
    Fin = Start + DelayTime
    RunTime = Now + TimeValue("00:00:" & Start)
    Application.OnTime RunTime, "MaMacroDeb"
    RunTime = Now + TimeValue("00:00:" & Fin)
    Application.OnTime RunTime, "MaMacroFin"
End Sub
Sub MaMacroDeb()
  With ActiveSheet.Shapes("Triangle1")
    .Fill.ForeColor.RGB = RGB(255, 0, 0)
  End With
End Sub
Sub MaMacroFin()
  With ActiveSheet.Shapes("Triangle1")
    .Fill.ForeColor.RGB = RGB(0, 255, 0)
  End With
End Sub

Ami calmant, J.P

sylvanu · Vendredi à 18:10

Re, bonjour Jurrasic Pork,
En figeant l'écarn pendant l'attente, un essai en PJ avec :

VB:

Sub changementcouleurauclicpdtsecondes()
Temps = Int([G13] - [G12])
ActiveSheet.Shapes("Image 3").Fill.ForeColor.RGB = RGB(255, 0, 0)
Application.ScreenUpdating = True
Application.Wait Time + TimeSerial(0, 0, Temps)
ActiveSheet.Shapes("Image 3").Fill.ForeColor.RGB = RGB(255, 255, 255)
End Sub

Le temps sera un entier de secondes, sinon il faut modifier le code.

jurassic pork · Vendredi à 18:15

Le souci avec ma solution c'est que ça ne bloque pas la saisie dans le classeur mais si on fait cela, les macros risquent de ne pas se dérouler normalement

sylvanu · Vendredi à 18:18

matlatarte à dit:
après si plus simple sans, pas bien grave

Comme je suis fainéant, et que c'est accepté par le demandeur .... j'ai fait au plus simple.

matlatarte · Vendredi à 18:19

MERCI les deux me vont ! je vais magouiller avec !

matlatarte · Vendredi à 18:28

J'ai réutilisé la première avec des renvois à des cellules pour les valeurs en seconde mais il n'a l'air de prendre que des secondes entières (pas de decimal) sinon bug... un moyen d'affiner cela ?

Dim RunTime As Date, Start, Fin, DelayTime
Start = Range("F13").Value
DelayTime = Range("G13").Value
Fin = Start + DelayTime

RunTime = Now + TimeValue("00:00:" & Start)
Application.OnTime RunTime, "MaMacroDeb"
RunTime = Now + TimeValue("00:00:" & Fin)
Application.OnTime RunTime, "MaMacroFin"

je préfère cette première car on peut modifier le début du changement de couleur, la deuxième ne bug pas avec les décimales mais ne les prend pas en compte

jurassic pork · Vendredi à 18:40

matlatarte à dit:
J'ai réutilisé la première avec des renvois à des cellules pour les valeurs en seconde mais il n'a l'air de prendre que des secondes entières (pas de decimal) sinon bug... un moyen d'affiner cela ?

Non Application.OnTime et Application.Wait ne prennent en compte que des secondes entières, sinon il faut passer par des API Windows

Dranreb · Vendredi à 18:42

Bonsoir.
Je joins mon ListeAléat, dont le thème est sans rapport avec la discussion, juste parce que depuis un certain temps mes objets de formulaire y ont été agrémentés d'effets visuels analogues par contre à son objet. Par exemple quand on clique sur la roue de loterie servant à lancer un tirage, celle ci s'auréole d'un éclat bleuâtre (en même temps qu'elle change d'image au profit d'une roue en train de tourner). Une fois le tirage terminé ou hélas abandonné, l'image de la roue fixe revient mais l'éclat persiste un peu et disparait peu à peu en même temps que revient l'ombre de la roue …

matlatarte · Samedi à 10:28

Bonjour,

J'ai une bizarrerie; je lance un fichier son en même temps que la séquence changement de couleur. Le changement arrive avec un élément dans le fichier son (d'où les 2 s ou 4 etc...).

Le problème est que lorsque j'applique le code cela marche pas à tous les coups: des fois cela respecte bien le timing des fois j'ai une seconde de décalage et cela de manière aléatoire... avec le même fichier son... Au premier lancement de macro la couleur est souvent en avance, après pas trop mal et cela se redécale de manière aléatoire...

Cela dépend de la "seconde" du "now" pris en compte ? du temps de lancement de la macro ?

Un moyen de corriger cela ?

jurassic pork · Samedi à 10:38

Hello,
comment lances-tu ton fichier son ? Attention Excel est monotâche et il ne peut pas faire plusieurs macros en même temps.
Ami calmant, J.P

matlatarte · Samedi à 10:42

cela fonctionne pourtant comme cela:

Dim MonWav As String
MonWav = Range("AB32").Value '... chemin et nom à adapter
ExecuteExcel4Macro ("CALL(""winmm"",""PlaySoundA"",""JCJJ"",""" & MonWav & """, " & 0 & "," & &H1 & ")")

est ce pour cela que des écarts se créent ? (le temps de traitement d'une tache puis l'autre ?)

jurassic pork · Samedi à 11:01

ben apparemment tu mets bien le lancement du son en mode asynchrone c'est à dire sans attendre la fin pour passer à la suite. Tu les lances comment les unes par rapport aux autres tes macros ?

XL 2021 Colorer avec condition de temps

matlatarte

XLDnaute Junior

sylvanu

XLDnaute Barbatruc

matlatarte

XLDnaute Junior

Pièces jointes

jurassic pork

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

Pièces jointes

jurassic pork

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

matlatarte

XLDnaute Junior

matlatarte

XLDnaute Junior

jurassic pork

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

Pièces jointes

matlatarte

XLDnaute Junior

jurassic pork

XLDnaute Occasionnel

matlatarte

XLDnaute Junior

jurassic pork

XLDnaute Occasionnel

Discussions similaires