Macro clignotement cellule qui fonctionne pas bien

Résolu/Fermé
vieuxray - 7 oct. 2018 à 12:31
yg_be Messages postés 22724 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 - 10 oct. 2018 à 21:57
Bonjour a toutes et tous, forum bonjour,


Sous Windows 10 et Excel 2007

La macro ci-dessous fonctionne presque bien, mais dès que l'on modifie le "xTime" ca plante Excel.

Dommage macro courte facile a modifier et utiliser.

Le but pour moi étant d'avoir la cellule "F2" qui clignote plus rapidement ou donne un effet de Flash.

Pas trouver d'autres codes sur le net, si vous avez un autre code je suis preneur, merci a vous.

Merci a vous pour votre aide, bon dimanche a tous.

Ray


Sub StartBlink()
Dim xCell As Range: Dim xTime As Variant
Set xCell = Range("F2")

With ThisWorkbook.Worksheets("Feuil1").Range("F2").Font
If xCell.Font.Color = vbRed Then
xCell.Font.Color = vbWhite
Else
xCell.Font.Color = vbRed
End If
End With

xTime = Now + TimeSerial(0, 0, 0.9) 'diminuer pour clignotement plus rapide
Application.OnTime xTime, "'" & ThisWorkbook.Name & "'!StartBlink", , True
End Sub
'Créer un bouton pour lancer la macro et on reclique sur le bouton pour l'arrèter
A voir également:

16 réponses

yg_be Messages postés 22724 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476
7 oct. 2018 à 12:41
bonjour, trouvé sur le net un code qui permettrait d'aller en dessous de la seconde:
Option Explicit

Private Declare Function SetTimer Lib "user32" _
                        (ByVal hWnd As Long, _
                         ByVal nIDEvent As Long, _
                         ByVal uElapse As Long, _
                         ByVal lpTimerFunc As Long) As Long

Private Declare Function KillTimer Lib "user32" _
                        (ByVal hWnd As Long, _
                         ByVal nIDEvent As Long) As Long

Private m_TimerID As Long

'Note:  The duration is measured in milliseconds.
'         1,000 milliseconds = 1 second
Public Sub StartTimer(ByVal Duration As Long)
  'If the timer isn't already running, start it.
  If m_TimerID = 0 Then
    If Duration > 0 Then
      m_TimerID = SetTimer(0, 0, Duration, AddressOf TimerEvent)
      If m_TimerID = 0 Then
        MsgBox "Timer initialization failed!"
      End If
    Else
      MsgBox "The duration must be greater than zero."
    End If
  Else
    MsgBox "Timer already started."
  End If
End Sub

Public Sub StopTimer()
  'If the timer is already running, shut it off.
  If m_TimerID <> 0 Then
    KillTimer 0, m_TimerID
    m_TimerID = 0
  Else
    MsgBox "Timer is not active."
  End If
End Sub

Public Property Get TimerIsActive() As Boolean
  'A non-zero timer ID indicates that it's turned on.
  TimerIsActive = (m_TimerID <> 0)
End Property

Private Sub TimerEvent()
  Debug.Print "Timer event fired: "; Format$(Now, "long time")
End Sub
1
Salut yg_be,

Merci pour ta réponse, c'est sympa.

Bien vu je n'ai pas vu passer ce code dans mes recherches.

J'ai copier et mis le code dans un module mais je n'arrive pas a lancer la macro par contre j'ai trouver pour l'arrèter ihihih.

Tu peux svp me traduire un peu comment ca fonctionne, étant fâcher avec l'anglais la langue pas les gens.

Merci pour ton aide, bonne après midi.

Cdlt Ray
0
yg_be Messages postés 22724 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476
Modifié le 7 oct. 2018 à 16:04
exemple d'utilisation:
Option Explicit
Private Declare Function SetTimer Lib "user32" _
                        (ByVal hWnd As Long, _
                         ByVal nIDEvent As Long, _
                         ByVal uElapse As Long, _
                         ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" _
                        (ByVal hWnd As Long, _
                         ByVal nIDEvent As Long) As Long
Private m_TimerID As Long
Private Sub Blink()
Dim xCell As Range
Set xCell = Range("F2")
With ThisWorkbook.Worksheets("Feuil1").Range("F2").Font
    If xCell.Font.Color = vbRed Then
        xCell.Font.Color = vbWhite
    Else
        xCell.Font.Color = vbRed
    End If
End With
End Sub
Public Sub StartBlink()
Dim Duration As Long
Duration = 900     'fréquence de clignotement, en millisecondes
  'If the timer isn't already running, start it.
  If m_TimerID = 0 Then
    If Duration > 0 Then
      m_TimerID = SetTimer(0, 0, Duration, AddressOf Blink)
      If m_TimerID = 0 Then
        MsgBox "Timer initialization failed!"
      End If
    Else
      MsgBox "The duration must be greater than zero."
    End If
  Else
    MsgBox "Timer already started."
  End If
End Sub
Public Sub StopBlink()
  'If the timer is already running, shut it off.
  If m_TimerID <> 0 Then
    KillTimer 0, m_TimerID
    m_TimerID = 0
  Else
    MsgBox "Timer is not active."
  End If
End Sub

reviens-nous si pas clair
0
Salut yg_be,

Merci pour la modification, c'est maintenant ca fonctionne nickel
j'ai régler la fréquence a 100 ça plante pas Excel de plus s'arrète et démarre bien.

j'ai deux questions pendant que j'y suis sur le même sujet, svp si tu veux bien.

(Q-1) Sur ce timer serait t'il possible de faire en sorte qu'il s'arrète seul au bout d'un temps réglable ???

(Q-2) Dans ma Feuil1, cellule F2, j'ai un caractère en forme de cloche d'hôtellerie, qui clignote dans une ligne de largeur 30.

Je cherche une astuce qui pourrai agrandir le caractère (cloche) sans agrandir la largeur de la ligne mais juste agrandir centrer dans la cellule (F2) car ça un peu petit.

Voir svp la photo de la cellule (F2)
https://www.cjoint.com/c/HJhpBvgASuz

Merci a toi pour ton aide, bonne fin d'après midi.

Cdlt Ray
0
yg_be Messages postés 22724 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476
7 oct. 2018 à 17:40
pour la question 1, il suffit que la fonction Blink appelle StopBlink quand le temps est écoulé. tu n'as pas expliqué d'où viendrait ce temps réglable, donc je ne peux pas te proposer de code.
pour la question 2, as-tu essayé d'agrandir la taille du caractère cloche, en préservant la largeur de la colonne?
0
Re salut yg_be,

Je voulais afficher un message dans un USF1 pendant 10 secondes qui déclenche en même temps le clignotement de la cellule F2 (cloche)
puis a la fin de la tempo arrêt du clignotement et le message disparait automatiquement.

-Réglage de la vitesse de clignotement réglable, ça c'est bon avec ce programme que tu m'a donner.
-Tempo réglable de 5 a 30 secondes sont largement suffisants pour l'affichage du message.

merci a toi bonne soirée

Cdlt Ray
0
yg_be Messages postés 22724 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476
7 oct. 2018 à 18:44
suggestion avec Duree en secondes:
Option Explicit
Private Declare Function SetTimer Lib "user32" _
                        (ByVal hWnd As Long, _
                         ByVal nIDEvent As Long, _
                         ByVal uElapse As Long, _
                         ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" _
                        (ByVal hWnd As Long, _
                         ByVal nIDEvent As Long) As Long
Private m_TimerID As Long, m_fin As Date
Private Sub Blink()
Dim xCell As Range
Set xCell = Range("F2")
With ThisWorkbook.Worksheets("Feuil1").Range("F2").Font
    If xCell.Font.Color = vbRed Then
        xCell.Font.Color = vbWhite
    Else
        xCell.Font.Color = vbRed
    End If
End With
If Now > m_fin Then
    StopBlink
End If
End Sub
Public Sub StartBlink()
Dim Duration As Long
Dim Duree As Long
Duration = 900     ' fréquence de clignotement, en millisecondes
Duree = 30    ' durée du clignotement, en secondes
  'If the timer isn't already running, start it.
m_fin = Now + TimeSerial(0, 0, Duree)
If m_TimerID = 0 Then
    If Duration > 0 Then
      m_TimerID = SetTimer(0, 0, Duration, AddressOf Blink)
      If m_TimerID = 0 Then
        MsgBox "Timer initialization failed!"
      End If
    Else
      MsgBox "The duration must be greater than zero."
    End If
  Else
    MsgBox "Timer already started."
  End If
End Sub
Public Sub StopBlink()
  'If the timer is already running, shut it off.
  If m_TimerID <> 0 Then
    KillTimer 0, m_TimerID
    m_TimerID = 0
  Else
    MsgBox "Timer is not active."
  End If
End Sub
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
re salut
j'ai oublier, que veut tu dire pour la question N°2 a propos de l'agrandissement
du caractère de la cellule (F2), je ne vois pas comment faire.


Désolé un oubli
0
Re,

Dit donc ça rigole pas chez toi, quelle réactivité, cool.

Merci pour la modification du code, c'est juste super nickel comme je le souhaitai
je te remercie très sympathiquement pour l'aide que tu m'apportes.

Pour l'agrandissement j'ai fouiller un peu sur le net rien trouver sur le sujet "comment agrandir un caractère sans altérer la hauteur de la ligne"

Dit moi svp comment je dois faire, je vais essayer.

a plus tard merci a toi

Cdlt Ray
0
yg_be Messages postés 22724 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476
7 oct. 2018 à 20:17
tu avais écrit "la largeur de la ligne", c'est devenu la hauteur...
qu'est-ce qui t’empêche de réduire la hauteur de la ligne après avoir agrandi la taille du caractère?
0
Re yg_be,

Quand j'agrandi le caractère normalement par le grand (le grand A) du ruban d'excel et que j'essai de remonter la hauteur de ligne après, c'est le caractère ici la (sonnette) qui disparait.

Donc pas trouver d'autres astuces pour le moment.

Je vais voir demain si je trouve une idée

Merci beaucoup pour ton aide, bonne soirée a toi.

Cdlt Ray
0
Bonjour yg_be,

La macro fonctionne parfaitement, pour ça encore merci.
J'ai créer un USF1 et j'ai mis 3 Labels.

---Je souhaiterai dès que la macro StartBlink se lance ouvrir immédiatement l'USF1
---Puis juste avant d'arrèter StopBlink fermer l'USF1 puis arrèt de la macro.

J'ai fait des essais mais ça fonctionne pas comme il faut.
J'arrive a ouvrir l'USF1 mais la cellule (F2) ne clignote plus et l'USF1 ne referme pas.

Si tu peux voir svp, je remets ci-dessous le code qui fonctionne en temps que minuteur.

Bon début de semaine a toi et merci pour ton aide.

Cdlt Ray

Private Declare Function SetTimer Lib "user32" _
(ByVal hWnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" _
(ByVal hWnd As Long, _
ByVal nIDEvent As Long) As Long
Private m_TimerID As Long, m_fin As Date

Private Sub Blink()
Dim xCell As Range
Set xCell = Range("F2")

With ThisWorkbook.Worksheets("Feuil1").Range("F2").Font
If xCell.Font.Color = vbRed Then
xCell.Font.Color = vbWhite
Else
xCell.Font.Color = vbRed
End If
End With

If Now > m_fin Then
Call StopBlink
End If
End Sub

Public Sub StartBlink()
Dim Duration As Long: Dim Duree As Long
Duration = 100
Duree = 10

'Fréquence de clignotement, en millisecondes et Durée du clignotement, en secondes

m_fin = Now + TimeSerial(0, 0, Duree)
If m_TimerID = 0 Then
If Duration > 0 Then
m_TimerID = SetTimer(0, 0, Duration, AddressOf Blink)
If m_TimerID = 0 Then
MsgBox "Echec de l'initialisation du minuteur."
End If
Else
MsgBox "La durée doit être supérieure à zéro."
End If
Else
MsgBox "Timer déja démarré."
End If
End Sub

Public Sub StopBlink()
If m_TimerID <> 0 Then
KillTimer 0, m_TimerID
m_TimerID = 0
Else
MsgBox "Timer non actif."
End If
End Sub
0
yg_be Messages postés 22724 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476
8 oct. 2018 à 09:57
montre-nous ton meilleur essai.
0
Salut yg_be,

Voila c'est bon je viens de trouver, il fallait que je mette le "0" après
userform1.show 0 pour avoir accès a la feuil1 de calcul et reste accessible.

maintenant c'est bon.

Un dernier truc que je souhaiterai svp c'est incorporer dans mon USF1 un Scrollbar qui afficherai le décompte de la tempo.

Bon ça, je ne sais pas faire, si tu veux bien m'aider sur ce coup la, merci a toi.

Cdlt Ray


If Now > m_fin Then
Unload UserForm1 'Ferme l'USF1
Call StopBlink

End If
End Sub

Public Sub StartBlink()
Dim Duration As Long: Dim Duree As Long
Duration = 100: Duree = 10

UserForm1.Show 0 'Ouvre l'USF1

m_fin = Now + TimeSerial(0, 0, Duree)
If m_TimerID = 0 Then
If Duration > 0 Then
0
yg_be Messages postés 22724 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476
8 oct. 2018 à 13:00
Dans Blink(), tu peux calculer le nombre de secondes restantes ainsi:
(m_fin-now)*24*3600 
0
Salut yg_be,

Merci pour ta réponse,

J'obtiens ce chiffre voir photo ci-jointe qui se décompte bien dans mon USF1.
Mais un affichage de 10 a 0, donc deux chiffres au pire me suffit bien.

Aussi j'ai penser a créer déclarer une variable

Dim Décompte ???
Décompte = Format ????

Après je ne sais pas plus.

https://www.cjoint.com/c/HJil3yqSuPz

Merci pour ton aide, bonne après midi a toi

Cdlt Ray
0
yg_be Messages postés 22724 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476
Modifié le 8 oct. 2018 à 17:02
pour arrondir à deux chiffres après la virgule:
round((m_fin-now)*24*3600,2)
0
Re yg_be,

Merci pour ta réponse c'est bon pour moi.

Au fait pour l'agrandissement du caractère en F2 sans altérer la hauteur de ligne
impossible de trouver une astuce, dommage.

Je viens de mettre une progressBar dans mon USF1.

Je vais essayer de l'utiliser pour afficher le décompte de la tempo.

Merci pour ton aide, bonne soirée a toi.

Cdlt Ray
0
Salut yg_be,

J'ai essayer plusieurs codes trouvés sur le net pour la progressbar.

Mais ce n'ai pas évident pour moi.

Si tu peux m'aider un peu, ça m'arrangerai bien car je dois mal m'y prendre et je ne sais pas faire le code qui me permettrai d'utiliser le décompte du code de la macro que tu m'a fourni et améliorer pour mon cas.

Je souhaite une bonne journée et merci a toi.

Cdlt Ray
0
yg_be Messages postés 22724 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476
9 oct. 2018 à 12:13
je n'utilise pas de progress bar ni de formulaire Excel.
je peux jeter un coup d’œil à ton code, à tout hasard.
0
Salut yg_be,

Merci pour ta réponse c'est sympa et merci de t'intérresser a mon soucis.

Le lien pour récupérer le fichier, ci-dessous.

https://www.cjoint.com/c/HJjl2cXbXiz

Dans la Feuil1 clic sur StartBlink attends 5 secondes tout s'arrète tout seul.

Ca fonctionne avec le code qui se trouve dans l'USF1 que j'ai trouvé sur le net entre temps depuis mon message.

Mais la c'est juste pour démo, ça ne corresponds pas a la valeur de la tempo de la macro.

--Ce qu'il me faudrait maintenant svp c'est utiliser "les valeurs qui décompte du code de la macro" que tu m'a fourni
et les intégrés pour faire avancer le progressBar.

Si possible paramétrable car pour l'instant j'ai mis 5 Secondes pour tester plus rapidement mais j'aurai peut être besoin de modifier, une variable serait l'idéale, merci.

Ex: 5 secondes devrait correspondre a la totalité de la course du progressbar
Ex:15 secondes idem etc etc

Merci pour ton aide, une bonne après midi a toi.

Cdlt Ray
0
yg_be Messages postés 22724 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476 > vieuxray
9 oct. 2018 à 22:38
suggestion:
Public Sub Blink()
Dim xCell As Range
Dim maintenant As Date
maintenant = Now
Set xCell = Range("F2")
With ThisWorkbook.Worksheets("Feuil1").Range("F2").Font
    If xCell.Font.Color = vbRed Then
       xCell.Font.Color = vbWhite
  Else
        xCell.Font.Color = vbRed
    End If
End With
If maintenant > m_fin Then
    Unload UserForm1                                        'Ferme l'USF1
    Call StopBlink                                               'Appel macro arrèt clignotement "STOPBLINK"
Else
    UserForm1.Label2.Caption = Round((m_fin - maintenant) * 24 * 3600, 0)
    UserForm1.ProgressBar1.Value = UserForm1.ProgressBar1.Max - UserForm1.Label2.Caption
End If
 

End Sub

Public Sub StartBlink()
Dim Duration As Long: Dim Duree As Long

Duration = 100: Duree = 20                            'Fréquence de clignotement, en millisecondes et Durée du clignotement, en secondes
    
    UserForm1.Show 0                                  'Ouvre l'USF1 Pour que les feuilles de calcul restent accessibles passer la boite de dialogue en mode non modal La propriété ShowModal doit être égale à False.
    UserForm1.Label1.Caption = "ATTENTION" + Chr$(13) & Chr$(10) + "Une erreur de formule est survenue" + Chr$(13) & Chr$(10) + "Veuillez réparer en recopiant la formule" _
               + Chr$(13) & Chr$(10) + "avec la poignée en croix de la cellule" + Chr$(13) & Chr$(10) + "du dessus ou du dessous, svp."                                          'Affiche message Label1
    
    UserForm1.ProgressBar1.Min = 0
    UserForm1.ProgressBar1.Max = Duree
m_fin = Now + TimeSerial(0, 0, Duree)
If m_TimerID = 0 Then
    If Duration > 0 Then
      m_TimerID = SetTimer(0, 0, Duration, AddressOf Blink)
      If m_TimerID = 0 Then
        MsgBox "Echec de l'initialisation du minuteur."
      End If
    Else
        MsgBox "La durée doit être supérieure à zéro."
    End If
  Else
        MsgBox "Timer déja démarré."
  End If
End Sub
0
Bonjour, yg_be,

Merci pour l'adaptation, ça fonctionne presque.

Il y a juste un décalage entre le remplissage de la progressBar et temps écoulé, voir svp la photo sur le lien ci-dessous.

https://www.cjoint.com/c/HJkff5PbA4z

J'ai chercher une formule variable et modifiable a adapter en fonction de la durée, mais pas trouvé.

J'ai noter que l'écart n'ai pas le même selon que l'on modifie la durée.

Merci a toi, passe une agréable journée.

Cdlt Ray
0
yg_be Messages postés 22724 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476
10 oct. 2018 à 17:55
le formulaire semble différent de celui qui est dans le fichier que tu m'as envoyé.
peux-tu envoyer un nouveau fichier?
0
quelqu'un a mis le post en résolu alors que j'attends une réponse pas cool ça
0
yg_be Messages postés 22724 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476
10 oct. 2018 à 17:49
c'est moi: à un moment tout était en ordre, j'ai mis résolu, et puis tu as relancé avec une autre question.
0
Salut yg_be,

Ok, pour le résolu, ça aurai pu être moi par mégarde, mais vu que je t'avais envoyer la photo, mais bon c'est pas grave.

J'ai eu ton fichier ce matin de bonne heure, je l'ai essayer et le résultat est décaler comme le montre la photo que je t'ai envoyer, voir le lien ci-dessus.

Le fichier que tu as, c'est exactement le même que le mien.

Je te le renvoie quand même au cas ou.

https://www.cjoint.com/c/HJkqCp0PfEz

Merci pour ton aide, je te souhaite la bonne soirée.

Cdlt Ray
0
yg_be Messages postés 22724 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476
10 oct. 2018 à 20:13
voici ce que je vois, et qui me semble correct, mais différent de ce que tu montres.
0
Salut

j'ai bien vu la photo ça semble correct, a tu fait des essais avec d'autres valeurs, je comprends pas des fois c'est décaler et des fois non hum bizarre.

Bon si tu trouves correct alors on laisse comme ca je verrais bien dans le temps.

Je considère également que c'est bon aussi.

Juste une question, tu n'a retoucher le fichier ???

Je te remercie avec beaucoup beaucoup de merci, bonne fin de soirée a toi.

Merci aussi pour ta patience, mais ca marche c'est la l'essentiel.

Salut et sans doute a bientôt LOL.

Bien cordialement Ray
0
yg_be Messages postés 22724 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476
10 oct. 2018 à 21:57
rien retouché, juste ouvert et cliqué sur le gros bouton "startblink".
pas refait d'essai avec d'autres valeurs.
0