XL 2016 Horloge qui démarre automatiquement à l'ouverture du fichier.

[ReneDav14000]

Bonjour à toutes et à tous,
Dans ma feuille d'accueil, j'ai une petite horloge où doit défiler l'heure en temps réel.
J'ai testé plusieurs codes trouvé sur le Net mais sans succès dont celui-ci mais demande l'ajout de bouton, hors je souhaite que l'horloge se mette en marche dès l'ouverture du fichier.
Je joins également une copie écran de la page "Accueil".
Nous sommes le : correspond à la cellule R1 (formule = MAINTENANT())
et il est : correspond à la cellule R2 (formule = MAINTENANT()).
Comment modifier ce code afin que l'heure tourne en discontinu ?
Merci par avance pour votre aide

Public Declare PtrSafe Function SetTimer Lib "user32" (ByVal HWnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As LongPtr, ByVal lpTimerFunc As LongPtr) As LongPtr
Public Declare PtrSafe Function KillTimer Lib "user32" (ByVal HWnd As LongPtr, ByVal nIDEvent As LongPtr) As LongPtr
Public montimer As LongPtr
Sub demarre()
    montimer = SetTimer(0&, 0&, 500&, AddressOf heure)     'le timer tournera et se repetera tout seul on le lance qu'une seule fois
End Sub

Sub arrete()
  On Error Resume Next
  KillTimer 0&, montimer  'on kill le timer
Range("A1") = "heure"
End Sub

Sub heure(ByVal HWnd As LongPtr, ByVal uMsg As LongPtr, ByVal nIDEvent As LongPtr, ByVal dwTimer As LongPtr)
    Range("A1") = Time
End Sub

 

[vgendron]

Bonjour

les images ne nous servent à rien..

fais un appel à ta macro "demarre" dans l'évènement thisworkbook_open

 

[ReneDav14000]

Bonjour vgendron,
Merci pour ta réponse, c'est exactement ce que j'ai fais, mais l'heure reste fixe.
Je continue à chercher

 

[patricktoulon]

re
Bonjour envoie un fichier

 

[patricktoulon]

re
dans le module thisworkbook

Private Sub Workbook_BeforeClose(Cancel As Boolean)
StopHorloge
End Sub

Private Sub Workbook_Open()
StartHorloge
End Sub

dans un module standard

Option Explicit
Public Declare PtrSafe Function SetTimer Lib "user32" (ByVal HWnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As LongPtr, ByVal lpTimerFunc As LongPtr) As LongPtr
Public Declare PtrSafe Function KillTimer Lib "user32" (ByVal HWnd As LongPtr, ByVal nIDEvent As LongPtr) As LongPtr
Public montimer As LongPtr
Sub StartHorloge()
    montimer = SetTimer(0&, 0&, 500&, AddressOf heure)     'le timer tournera et se repetera tout seul on le lance qu'une seule fois
End Sub

Sub StopHorloge()
  On Error Resume Next
  KillTimer 0&, montimer  'on kill le timer
Range("A1") = "heure"
End Sub

Sub heure(ByVal HWnd As LongPtr, ByVal uMsg As LongPtr, ByVal nIDEvent As LongPtr, ByVal dwTimer As LongPtr)
    On Error Resume Next
    Range("A1") = Time
End Sub

 

[Katido]

Bonjour,

Un petit code tout simple sana API :

Public Sub Horloge()
[E6] = Format$(Now, "HH:NN:SS")
DoEvents
Application.OnTime Now + 1 / 86400, "Horloge"
End Sub

On peut facilement ajouter un booléen pour arrêter l'horloge.

 

[patricktoulon]

Bonjour @Katido
avec l'api set timer c'est plus précis
dans le sens ou si les secondes sont importantes l'ecart entre deux mises à jour est moins important que 1 seconde avec ta méthode(ontime)

 

[Katido]

Bonjour,

A-t-on vraiment besoin d'être plus précis que la seconde ?
Si oui :
1) il ne faut pas utiliser Now()
2) quoi qu'on fasse, on gaspille du temps machine
3) ça devient vite usinagazesque

Si on reste raisonnable, et avec le booléen dont je parlais précédemment :

Public Sub Horloge(Optional runfg As Boolean = True)
[E14] = Format$(Now, "HH:NN:SS")
Application.OnTime Now + 1 / 86400, "Horloge", , runfg
End Sub

 

[Dranreb]

Bonjour.
Une horloge (initialement) dans la feuille "Autre solution chrono" de ce classeur.

 

[ReneDav14000]

Bonjour à tous,
patrick, ton code ne fonctionne pas chez moi.
Katido, ton code fonctionne à-peu-près car les cellules clignotent à chaque seconde.
Désolé de répondre tardivement, mais c'est très difficile en ce moment côté santé.
Voici mon fichier très allégé.

 

[Katido]

Rebonjour,
@ReneDav14000 : Chez moi c'est stable. Je suis en Excel 365. As-tu essayé la derdière mouture sans le DoEvents ?
@Dranreb : Joli chrono !

 

[Dranreb]

Votre classeur équipé d'un Rythmeur.
Remarque: Je préfèrerais que les zones de texte soient en contrôles ActiveX plutôt que Shape
(toujours un peu casse-gueule de changer des entités Excel depuis un Timer car il peut se déclencher à n'importe quelle phase de maintenance interne des données de l'application. Les contrôles ActiveX en sont plus indépendants, proches de VBA …)

 

[patricktoulon]

re
comme d'habitude @ReneDav14000 , tu ne facilite pas la tache de ceux qui t'aident
aujourd’hui tu nous plombe le ruban (comment veux tu que celui qui ne sait pas; aille voir dans vba)
heureusement j'ai mes astuces pour déplomber un ruban perso par vba

bref mon code fonctionne tres bien
je met même l'heure ou elle doit être d'ailleurs

 

[ReneDav14000]

Bonsoir à tous,
Je vais regarder vos propositions un peu plus tard quand j'irai mieux.
Merci pour vos participations et désolé de ne pouvoir vous donner de réponse immédiate.
Bonne soirée à tous et à très bientôt

 

[chaelie2015]

Bonjour à toutes et à tous,
Dans ma feuille d'accueil, j'ai une petite horloge où doit défiler l'heure en temps réel.
J'ai testé plusieurs codes trouvé sur le Net mais sans succès dont celui-ci mais demande l'ajout de bouton, hors je souhaite que l'horloge se mette en marche dès l'ouverture du fichier.
Je joins également une copie écran de la page "Accueil".
Nous sommes le : correspond à la cellule R1 (formule = MAINTENANT())
et il est : correspond à la cellule R2 (formule = MAINTENANT()).
Comment modifier ce code afin que l'heure tourne en discontinu ?
Merci par avance pour votre aide

Public Declare PtrSafe Function SetTimer Lib "user32" (ByVal HWnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As LongPtr, ByVal lpTimerFunc As LongPtr) As LongPtr
Public Declare PtrSafe Function KillTimer Lib "user32" (ByVal HWnd As LongPtr, ByVal nIDEvent As LongPtr) As LongPtr
Public montimer As LongPtr
Sub demarre()
    montimer = SetTimer(0&, 0&, 500&, AddressOf heure)     'le timer tournera et se repetera tout seul on le lance qu'une seule fois
End Sub

Sub arrete()
  On Error Resume Next
  KillTimer 0&, montimer  'on kill le timer
Range("A1") = "heure"
End Sub

Sub heure(ByVal HWnd As LongPtr, ByVal uMsg As LongPtr, ByVal nIDEvent As LongPtr, ByVal dwTimer As LongPtr)
    Range("A1") = Time
End Sub

Regarde la pièce jointe 1160851

Bonsoir
Pour que l'horloge tourne en continu sans avoir besoin d'un bouton, il faut déclencher la fonction "demarre()" lors de l'ouverture de la feuille "Accueil". Pour ce faire, vous pouvez utiliser l'événement "Workbook_Open" de la feuille de calcul Excel.
Dans le module de la feuille "Accueil", tapez le code suivant :
Private Sub Workbook_Open()
demarre
End Sub
Cela déclenchera la fonction "demarre()" lorsque vous ouvrez la feuille de calcul Excel. Il est important de noter que la horloge continuera à tourner jusqu'à ce que vous fermiez Excel. Il n'y a pas de fonction arrete() ici.
A+