Label clignotant

[mfb]

Bonjour à TOUTES et TOUS.
J'ai récupéré sur ce forum un exemple de label clignotant créé par EMG le 10.02.2004.
Il me convient bien.
Je rencontre toutefois un petit pb car après essai je me suis rendu qu'il devenait impossible d'intervenir sur le code
que ce soit pour modifier supprimer ou ajouter. Excel est inopérent.
Même après fermeture sans prise en compte des modifs tous les codes du fichier restent impénétrables.
Toutefois si l'exemple présente le même Pb l'écriture redevient possible après fermeture et réouverture.
Dans l'exemple est-il possible de remédier à ce petit os.
Merci par avance

Pas de souci pour mon fichier je peut recommencer.
Daniel

 

[Dranreb]

Re : Label clignotant

Bonjour.
Le problème vient de ce que la procédure UserForm_Activate continue de s'exécuter même après que l'UserForm soit déchargé.
Il faudrait une meilleure communication avec la CommandButton1_Click
Le Range("A1") ne me parait pas être un bon support. Il n'est d'ailleurs pas remis à 0 par la CommandButton1_Click, c'est pourquoi l'autre n'a aucune raison de s'arrêter. Un Boolean ArrêtDemandé me paraîtrait mieux.

 

[mfb]

Re : Label clignotant

Bonsoir Dranreb, .. et les autres
Merci d'avoir répondu si vite.
J'ai essayé avec la remise de A1 à 0 via le bouton1 cela marche.
Si Boolean ArrêtDemandé est mieux je veux bien mais pour moi, Boolean, vu mes connaissance est un inconnu.
Je me permets d'abuser en te demandant quelque tuyaux la dessus.
Merci
Daniel

 

[Dranreb]

Re : Label clignotant

Je viens de tout réécrire comme ça, ça ne me semble pas mal.

Option Explicit
Dim Top As Single, ArrêtDemandé As Boolean

Private Sub UserForm_Activate()
Dim Basc As Boolean
ArrêtDemandé = False
Top = VBA.Timer
Do
   Attendre 0.15
   Basc = Not Basc
   Label1.BackColor = IIf(Basc, &H8000000F, &HFF)
   Label1.ForeColor = IIf(Basc, 0, &HFFFF&)
   DoEvents
   Loop Until ArrêtDemandé And Basc
Image2.Visible = True
Label2.Visible = True
DoEvents
Attendre 5
Unload Me
End Sub

Private Sub CommandButton1_Click()
ArrêtDemandé = True
End Sub

Private Sub Attendre(ByVal NbSec As Single)
Dim Tip As Single
Do: Tip = VBA.Timer
   If Tip < Top Then Top = Top - 86400
   Loop Until Tip - Top >= NbSec
Top = Top + NbSec
End Sub

P.S Je l'ai modifié car il n'était pas toujours garanti que ça s'arrêtait avec le label police noire sur fond gris.

 

[mfb]

Re : Label clignotant

Re,
Encore Merci Dranreb,
C'est super ça marche.
Il me reste à intégrer dans mon application.
Bonne soirée
Daniel

 

[Dranreb]

Re : Label clignotant

Un DoEvents unique peut se laisser dans la procédure Attendre et même un test de ArrêtDemandé :

Option Explicit
Dim Top As Single, ArrêtDemandé As Boolean

Private Sub UserForm_Activate()
Dim Basc As Boolean
ArrêtDemandé = False
Top = VBA.Timer
Do
   Attendre 0.15
   Basc = Not Basc
   Label1.BackColor = IIf(Basc, &H8000000F, &HFF)
   Label1.ForeColor = IIf(Basc, 0, &HFFFF&)
   Loop Until ArrêtDemandé And Basc
Image2.Visible = True
Label2.Visible = True
ArrêtDemandé = False
Attendre 5
Unload Me
End Sub

Private Sub CommandButton1_Click()
ArrêtDemandé = True
End Sub

Private Sub Attendre(ByVal NbSec As Single)
Dim Tip As Single
Do: Tip = VBA.Timer
   If Tip < Top Then Top = Top - 86400
   If ArrêtDemandé Then Top = Tip: Exit Sub
   DoEvents: Loop Until Tip - Top >= NbSec
Top = Top + NbSec
End Sub