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

ReneDav14000 · 20 Janvier 2023

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

VB:

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

patricktoulon · 21 Janvier 2023

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

vgendron · 20 Janvier 2023

Bonjour

les images ne nous servent à rien..

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

ReneDav14000 · 20 Janvier 2023

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

patricktoulon · 20 Janvier 2023

re
Bonjour envoie un fichier

patricktoulon · 20 Janvier 2023

re
dans le module thisworkbook

VB:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
StopHorloge
End Sub

Private Sub Workbook_Open()
StartHorloge
End Sub

dans un module standard

VB:

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 · 20 Janvier 2023

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 · 21 Janvier 2023

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 · 21 Janvier 2023

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 · 21 Janvier 2023

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

ReneDav14000 · 21 Janvier 2023

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 · 21 Janvier 2023

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 · 21 Janvier 2023

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 · 21 Janvier 2023

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 · 21 Janvier 2023

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 · 21 Janvier 2023

ReneDav14000 à dit:
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

VB:

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+

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

ReneDav14000

XLDnaute Occasionnel

patricktoulon

vgendron

XLDnaute Barbatruc

ReneDav14000

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Katido

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

Katido

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

Pièces jointes

ReneDav14000

XLDnaute Occasionnel

Pièces jointes

Katido

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

Pièces jointes

ReneDav14000

XLDnaute Occasionnel

chaelie2015

XLDnaute Accro

Discussions similaires