XL 2021 Colorer avec condition de temps

matlatarte

XLDnaute Junior
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

XLDnaute Barbatruc
Supporter XLD
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. ;)
 

jurassic pork

XLDnaute Occasionnel
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

CouleurTriangle.gif


Ami calmant, J.P
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
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.
 

Pièces jointes

  • Classeur1 (2).xlsm
    47.8 KB · Affichages: 2

matlatarte

XLDnaute Junior
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
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
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 …
 

Pièces jointes

  • ListeAléat.xlsm
    566.4 KB · Affichages: 7

matlatarte

XLDnaute Junior
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 ?
 

matlatarte

XLDnaute Junior
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 ?)
 

Discussions similaires

Statistiques des forums

Discussions
314 731
Messages
2 112 278
Membres
111 493
dernier inscrit
lauryd65