Décompte

[guy72]

Bonjour,
Je suis à la recherche d'un chrono qui décompterait de 0 à 3 minutes environ, qui se déclencherait avec un bouton dans le USF.
Et tout en pouvant travailler sur ce USF pendant le décompte.
Merci de votre aide
Cordialement
Guy

 

[PMO2]

Re : Décompte

Bonjour,

Une piste avec la démarche suivante

1) créez un UserForm1 aved un contrôle Label1
2) dans le fenêtre de code du UserForm, copiez le code suivant

Private Sub UserForm_Activate()
ARRET = False
Debut = Now
Fin = Debut + DUREE / 86400
With UserForm1.Label1
  .Caption = PREFIXE & Format(Fin - Now, "hh:mm:ss")
  .BackColor = Me.BackColor
End With
Call Rebours
End Sub

Private Sub UserForm_Initialize()
Dim SP As Object
With Me
  .Top = 0
  .Left = 0
  .Height = 400
  .Width = 600
End With
With Me.Label1
  .Top = 350
  .Left = 12
  .Height = 10
  .Width = 100
End With

    '--- Pour illustration, un contrôle SpreadSheet est créé ---
Set SP = Me.Controls.Add("owc11.Spreadsheet.11")
ThisWorkbook.Sheets(1).Cells.Copy
With SP
  .Top = 20
  .Left = 20
  .Height = 300
  .Width = 560
End With
SP.Sheets(1).Cells.Paste
SP.Sheets(1).[a1].Select
Application.CutCopyMode = False
  '-------------------------------------------------------------
  
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
ARRET = True
Unload Me
End Sub

3) dans un module standard, copiez le code suivant

'### Constantes à adapter ###
Public Const DUREE As Long = 15                   'durée en secondes
Public Const PREFIXE As String = "Temps restant " 'préfixe qui s'inscrit dans le Label
'############################

Public Debut As Date
Public Fin As Date
Public ARRET As Boolean

Sub Rebours(Optional dummy As Byte)
Dim Pause As Single
Dim Start As Single
Dim A$
If ARRET Then Exit Sub
On Error GoTo Erreur
Pause = 1   'intervalle du décompte en seconde
Start = Timer
Do While Timer < Start + Pause
  DoEvents
Loop
If Now >= Fin Then
  Unload UserForm1
  Exit Sub
End If
If Now + (10 / 86400) >= Fin Then
  Beep
  UserForm1.Label1.BackColor = vbRed
End If
A$ = Format(Fin - Now, "hh:mm:ss")
UserForm1.Label1.Caption = PREFIXE & A$
Call Rebours 'appel récursif
Exit Sub
'--- Pseudo traitement d'erreur ---
Erreur:
End Sub
 
Sub Lancer()
UserForm1.Show vbModeless
End Sub

Il n'y a plus qu'à lancer le programme (avec la macro bien nommée "Lancer")

Cordialement.

PMO
Patrick Morange

 

[guy72]

Re : Décompte

Bonjour,
Ça me plaît bien.
Il faut que j'essaye de l'adapter à mon USF.
Je te tiens au courant.
En attendant, merci de ton aide.
Cordialement
Guy

 

[guy72]

Re : Décompte

Bonjour,
Je souhaiterais lancer le chrono avec un bouton dans le USF.
Je ne vois pas quoi modifier ?
Cordialement
Guy

 

[PMO2]

Re : Décompte

Bonjour,

Je souhaiterais lancer le chrono avec un bouton dans le USF.

1) ajoutez un contrôle CommandButton1 au UserForm
2) dans la fenêtre de code du UserForm remplacez tout l'ancien code par le code suivant

Private Sub CommandButton1_Click()
UserForm1.CommandButton1.Visible = False
ARRET = False
Debut = Now
Fin = Debut + DUREE / 86400
With UserForm1.Label1
  .Caption = PREFIXE & Format(Fin - Now, "hh:mm:ss")
  .BackColor = Me.BackColor
End With
Call Rebours
End Sub

Private Sub UserForm_Initialize()
Dim SP As Object
With Me
  .Top = 0
  .Left = 0
  .Height = 400
  .Width = 600
End With
With Me.Label1
  .Top = 350
  .Left = 12
  .Height = 10
  .Width = 100
  .Caption = ""
End With
With Me.CommandButton1
  .Top = 330
  .Left = 450
  .Height = 30
  .Width = 100
  .Caption = "Lancer le chrono"
End With

    '--- Pour illustration, un contrôle SpreadSheet est créé ---
Set SP = Me.Controls.Add("owc11.Spreadsheet.11")
ThisWorkbook.Sheets(1).Cells.Copy
With SP
  .Top = 20
  .Left = 20
  .Height = 300
  .Width = 560
End With
SP.Sheets(1).Cells.Paste
SP.Sheets(1).[a1].Select
Application.CutCopyMode = False
  '-------------------------------------------------------------
  
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
ARRET = True
Unload Me
End Sub

Cordialement.

PMO
Patrick Morange

 

[guy72]

Re : Décompte

Bonjour,
Effectivement, suis-je bête, je n'ai pas réfléchi, j'aurais du trouver.
Par contre, j'ai bien empêché que le USF de disparaisse à la fin du chrono comme je le souhaite.
Le chrono s'arrête bien, le USF reste bien, mais il reste à "00:00:01".
Est-il possible de voir "00:00:00" ?
Encore merci de ton aide.
Cordialement
Guy

 

[PMO2]

Re : Décompte

Bonjour,

Le chrono s'arrête bien, le USF reste bien, mais il reste à "00:00:01".
Est-il possible de voir "00:00:00"

Modifiez la Sub Rebours comme suit

Sub Rebours(Optional dummy As Byte)
Dim Pause As Single
Dim Start As Single
Dim A$
If ARRET Then Exit Sub
On Error GoTo Erreur
Pause = 1   'intervalle du décompte en seconde
Start = Timer
Do While Timer < Start + Pause
  DoEvents
Loop
If Now >= Fin Then
  
[B][COLOR="Blue"]    '/// modif pmo ///
  UserForm1.Label1.Caption = PREFIXE & Format(0, "hh:mm:ss")
  'Unload UserForm1
    '/////////////////[/COLOR][/B]
    
  Exit Sub
End If
If Now + (10 / 86400) >= Fin Then
  Beep
  UserForm1.Label1.BackColor = vbRed
End If
A$ = Format(Fin - Now, "hh:mm:ss")
UserForm1.Label1.Caption = PREFIXE & A$
Call Rebours 'appel récursif
Exit Sub
'--- Pseudo traitement d'erreur ---
Erreur:
End Sub

Cordialement.

PMO
Patrick Morange

 

[guy72]

Re : Décompte

Bonjour,
C'est tout simplement parfait.
Merci de ton aide.
A+
Cordialement
Guy