Espacer l'exécution d'une macro cyclique d'une seconde avec la fonction timer

Version imprimable

Bonjour la communauté,

Voici mon soucis que j'aimerais partager avec vous en quête de solution.
J'ai un userform sur lequel j'ai disposé 8 labels dont les bordures doivent prendre une
couleur définie successivement sans interruption afin de créer une boucle.

Pour parler plus simple, à l'activation du formulaire, la bordure du label1
prend la couleur définie, ensuite c'est au tour du label pendant que le label
retrouve sa couleur initiale ..... ainsi de suite jusqu'au label 8. Et la boucle
recommence.

Mon soucis, c'est qu je souhaite espacer les changements des couleurs des bordures d'une
(01) seconde. J'ai essayer la fonction Application.Wait Now qui marche bien, mais elle consomme
tellement de ressources et ralentie la macro.

Je veux bien essayer la fonction Timer, mais elle s’exécute trop rapidement. quelqu'un saurait-il
comment utiliser cette dernière fonction mais qui me permettrait d'espacer l’exécution de mes instructions
d'au moins une 1/2 seconde (1 seconde tout au plus)?

Ci-après mon code. Cordialement!
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 Private Sub UserForm_Activate() Dim Debut Debut = Timer Actif = 1 Inactif = 8 Application.ScreenUpdating = False Do While Timer > 0 Actif = Actif + 1 Me.Controls("Label" & Actif Mod 8 + 1).BorderStyle = fmBorderStyleSingle Me.Controls("Label" & Actif Mod 8 + 1).BorderColor = RGB(31, 78, 121) Me.Controls("Label" & Actif Mod 8 + 1).BackColor = RGB(255, 255, 255) Me.Controls("Label" & Inactif Mod 8 + 1).BorderStyle = fmBorderStyleNone Me.Controls("Label" & Inactif Mod 8 + 1).BackColor = RGB(180, 199, 231) 'Application.Wait (Now + #12:00:01 AM#) 'Application.Wait Now + TimeValue("00:00:01") Inactif = Actif If Actif Mod 8 + 1 > 7 Then Inactif = 7 DoEvents Loop Application.ScreenUpdating = True End Sub

Bonjour,

non testé :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Sub UserForm_Activate()
    actif = 7
    m_TimerRefresh
End Sub
 
Sub m_TimerRefresh()
    'Label0 à Label7
    Me.Controls("Label" & actif).BorderStyle = fmBorderStyleNone
    Me.Controls("Label" & actif).BackColor = RGB(180, 199, 231)
    actif = (actif + 1) Mod 8
    Me.Controls("Label" & actif).BorderStyle = fmBorderStyleSingle
    Me.Controls("Label" & actif).BorderColor = RGB(31, 78, 121)
    Me.Controls("Label" & actif).BackColor = RGB(255, 255, 255)
    tsav = Now + TimeValue("00:00:01")
    Application.OnTime tsav, "m_TimerRefresh"
End Sub
 
Private Sub timerStop()
    ' arreter le timer
    On Error Resume Next
    Application.OnTime tsav, "m_TimerRefresh", , Schedule:=False
    On Error GoTo 0
End Sub

tu ne restes plus bloqué dans le UserForm_Activate comme avant, l'utilisateur pourra agir dedans.
Il faut peut-être en tenir compte.
eric

28/10/2019, 10h38
Bana13

Merci Eriiic,

J'ai testé votre code mais ça n'a pas l'air de fonctionner. Il y a le message
d'erreur "Objet introuvable" qui apparaît et la commande de débogage
souligne le code suivant:

Code:

Me.Controls("Label" & actif).BorderStyle = fmBorderStyleSingle
28/10/2019, 11h43
eriiic

Bonjour,

ça ce n'est pas mon code mais le tien.
Moi je n'ai fait qu'essayer d'y greffer la partie timer.
Lis aussi la ligne de commentaire : 'Label0 à Label7. A toi d'adapter si besoin tes n° de label ou le code si besoin
eric