Cherche petit code pour chrono
bonsoir à tous
un petit message sur le forum pour m'aider un incruster un chrono qui défile lorsque je clic sur un bouton! le bouton qui l'actionnera sert déja a quelque chose mais je veux qu'il commande également le départ du chrono! pouvez vous m'aider à compléter la formule pour pouvoir avoir se chrono qui défile dans la case A3:
voici mon bouton à completer:
Private Sub CommandButton1_Click()
CommandButton1.BackColor = RGB(255, 0, 0)
CommandButton1.ForeColor = RGB(0, 0, 0)
CommandButton1.Caption = "Course Parti à " & Time
Range("H4") = Format(Time, "hh:mm:ss")
Une des personne du forum m'a déja envoyé un fichier avec cette formule là :
Private Sub CommandButton1_Click()
'Bouton départ du chronomètre
CommandButton1.Visible = False
Worksheets(1).Cells(7, 4).Value = Format(0, "HH:MM:SS")
Temps = Time
SetTimer Application.hWnd, 0, 1000, AddressOf UpDateTime
End Sub
mais quand j'essai de la mettre dans mon fichier, basic me dit qu'il y à un pb sur AddressOf UpdateTime
Je remercie d'avance celui qui m'aidera à resoudre se dilemme
Clement
Bonsoir Forum
Clément, ton code n'est pas complet.
Bonsoir essaye ca
# Dans la partie workbook du classeur, insérer le code suivant
# 'On initialise le timer système dès l'ouverture du classeur
Private Sub Workbook_Open()
# 'Utilisation de l'API SetTimer toutes les secondes (1000 millisecondes) pour appeler la procédure UpDateTime
SetTimer Application.hWnd, 0, 1000, AddressOf UpDateTime
End Sub
#
# 'A la fermeture du classeur, on nettoie la place en supprimant l'appel au timer système
Private Sub Workbook_BeforeClose(Cancel As Boolean)
# 'On utilise le handle de l'application et l'ID de l'objet liés lors de l'initialisation du timer
KillTimer Application.hWnd, 0
End Sub
#
#
# 'Dans un module séparé, insérer le code suivant
# '==============================================
#
# 'On définit les 2 APIs systèmes qui seront utilisées
Public Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
#
# 'La fameuse fonction UpDateTime qui va se charger d'écrire dans la cellule voulue l'heure actuelle à chaque seconde
Public Sub UpDateTime (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)
# 'Afin que la feuille ne se ferme pas de manière inoportune suite à une erreur interne
# '(lors de l'édition d'une cellule ou l'accès à certaines boîtes de dialogue par exemple)
On Error Resume Next
# 'On écrit l'heure selon le format HH:MM:SS sur 24 heures.
# Worksheets(1).Cells(1.1).Value = Format(Time,"HH:MM:SS")
On Error Goto 0
End SubUsb512