Discussion :

[Bana13]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[eriiic]

Bonjour,

non testé :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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 :

Sélectionner tout - Visualiser dans une fenêtre à part

Me.Controls("Label" & actif).BorderStyle = fmBorderStyleSingle

[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