Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Horloge

phlaurent55

Nous a quittés en 2020
Repose en paix
Bonjour à toutes et tous,

Suite à un petit défi avec un ami qui me demandait de créer une animation de shapes en utilisant une barre de défilement, je me suis amusé à faire une Rotation de shapes en fonction du temps qui passe.

voici le résultat en pièce jointe (version 2007)

Je ne pose pas de question concernant ce fichier
............ si quelqu'un veut l'améliorer, il le peut

à+
Philippe
 

Pièces jointes

  • HORLOGE.xlsm
    22.9 KB · Affichages: 232

job75

XLDnaute Barbatruc
Re,

Bon les rotations des aiguilles des minutes et heures n'allaient pas, j'ai modifié la macro :
Code:
Sub Marche()
t = Now
ActiveSheet.Shapes("cptsec").TextFrame.Characters.Text = WorksheetFunction.Roman(Second(t))
ActiveSheet.Shapes("Groupe 50").Rotation = Second(t) * 6
ActiveSheet.Shapes("cptsec").Rotation = Second(t) / 60
ActiveSheet.Shapes("minutes").Rotation = (Minute(t) + Second(t) / 60) * 6
ActiveSheet.Shapes("heures").Rotation = (Hour(t) Mod 12 + Minute(t) / 60 + Second(t) / 3600) * 30
beep_api IIf(Second(t) Mod 2, 2100, 1800), 5
Arret
t = Format(t + 1 / 86400, "d/m/yy h:m:s")
Application.OnTime t, "Marche"
End Sub
Fichier (3).

Bonne nuit.
 

Pièces jointes

  • Horloge(3).xlsm
    167.6 KB · Affichages: 56

phlaurent55

Nous a quittés en 2020
Repose en paix
Re-bonjour à toutes et toutes

C'est vrai qu'il y a quelques petits problème de synchro avec l'aiguille des secondes dans les derniers fichiers postés mais je pense que cela vient du fait qu'on en demande un peu trop à la machine.
Merci à Job qui se donne du mal à vouloir tenter d'y remédier.

une petite constatation, le Shape qui affiche les secondes en chiffres romains devrait être un peu élargi car l'affichage des secondes 37 et 38 est incomplet.

Au départ j'avais initié ce fil de discussion pour montrer comment faire tourner des aiguilles (et comment les construire).
Merci à tous pour vos appréciations.

Pour moi, la meilleure révision est celle apportée par Modeste Geedee au post #9 et qui concerne la fluidité de la rotation

Ensuite nous sommes passés par des petits délires, l'horloge qui tourne à l'envers et Double 00 qui se prend pour un coucou.

Je vous souhaite à tous une bonne journée, je retourne dans mon atelier, ce n'est pas le boulot qui manque

à+
Philippe
 

job75

XLDnaute Barbatruc
Bonjour Philippe, le forum,

Les horloges classiques ont toujours une trotteuse qui fonctionne par saccade, conservons-la ainsi.

Par contre Application.OnTime n'est pas très fiable, il vaut mieux 2 boucles :
Code:
Declare Function beep_api Lib "kernel32" Alias "Beep" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Public march As Boolean 'variable mémorisée

Sub Marche()
Dim t As Date
march = True
While march
    t = Now
    ActiveSheet.Shapes("cptsec").TextFrame.Characters.Text = Second(t)
    ActiveSheet.Shapes("Groupe 50").Rotation = Second(t) * 6
    ActiveSheet.Shapes("cptsec").Rotation = 0
    ActiveSheet.Shapes("minutes").Rotation = (Minute(t) + Second(t) / 60) * 6
    ActiveSheet.Shapes("heures").Rotation = (Hour(t) Mod 12 + Minute(t) / 60 + Second(t) / 3600) * 30
    beep_api IIf(Second(t) Mod 2, 2100, 1800), 5
    t = CDate(Format(t + 1 / 86400, "d/m/yy h:m:s"))
    While Now < t: DoEvents: Wend
wend
End Sub

Sub Arret()
march = False
End Sub
Fichier (4).

Bonne journée.
 

Pièces jointes

  • Horloge(4).xlsm
    165.7 KB · Affichages: 68

Modeste geedee

XLDnaute Barbatruc
Bonsour® Il n’apparaît pas .... !
mais il se fait entendre...


Nb : retard d'affichage pendant la sonnerie des heures
 

Pièces jointes

  • ORVALOGE(gd).zip
    1.4 MB · Affichages: 68

Si...

XLDnaute Barbatruc
Re

Quelques remarques (avec mon Excel 2010)

Pour ton premier classeur Philippe, un clic bouton droit arrête l'horloge" .
La bulle des secondes m'a semblé superflue car on les voit s'égrener dans l'affichage de l'horaire.

Comme dans mes (mauvaises) habitudes j'ai proposé un exemple avec une programmation des plus réduites.

Pour tes propositions Job, Tac Tic ne fonctionne pas chez moi et je suis d'accord avec la trotteuse qui 'trotte menu' comme dans le dernier fichier de Geedee d'ailleurs.

Modeste, il me semble avoir entendu dire "il faut laisser le temps au temps !". Je rajouterais "Mais cela prend du temps "donc décalage oblige.

J'ai retrouvé dans mes archives une horloge graphique à base d'une proposition de Gérald ROUSSEL en 2002 (ÓÒ pas celle que j'ai dégotée dans mon grenier ).
 

Pièces jointes

  • horloge3.xlsm
    22 KB · Affichages: 82
  • ÓÒCoucou.xlsm
    254.3 KB · Affichages: 73

phlaurent55

Nous a quittés en 2020
Repose en paix
Re,

Quelques remarques (avec mon Excel 2010)

Pour ton premier classeur Philippe, un clic bouton droit arrête l'horloge" .

Re-bonjour,

C'est vrai qu'un clic-droit sur la feuille pour le premier classeur déposé au post#1 arrête le fonctionnement de l'horloge.
C'est également le cas pour les autres fichiers déposés dans ce fil de discussion
(même celui du post#38)

il est cependant facile d'y remédier avec ce code dans la feuille concernée:
Code:
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
End Sub

à+
Philippe
 

Lolote83

XLDnaute Barbatruc
Salut à tous.
un grand BRAVO à tous les contributeurs pour ces magnifiques réalisations.
C'est super, maintenant, on a même l'heure sur Excel.
Je ne vais pas faire l'affront à tous de proposer une horloge numérique (on est en 2017 tout de même !!!!)
BRAVO, BRAVO
@+ Lolote83
 

phlaurent55

Nous a quittés en 2020
Repose en paix
Re,

@lolotte,
Beau boulot,

Même réflexion qu'au post#39, ton horloge s'arrête lorsqu'on fait un clic-droit sur la feuille
On peut l'éviter en mettant ce code dans la feuille


Code:
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
End Sub

à+
Philippe
 
Dernière édition:

Discussions similaires

Réponses
10
Affichages
1 K
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…