Code pour compte à rebours (exercice en séries) et sons pour lancer et arréter les sé

[Fab117]

Salut,
Je souhaiterai faire un fichier permettant de donner le rythme lors d'exercice fait en série avec des durée variables.
Du type déut du 1 er exercice à maintenir pendant 10 , puis pause de 3 et enchainement avec exercice de 15 , suivi d'une pause de 5, ...

Mais c'est beaucoup plus compliqué que je pensais. Malgré une assez recherche dans le forum, je n'ai pas trouvé :
Comment initier le compte à rebours dans mes conditions
Charger les sons de début et de fin d'exercice qui sont dans le même répertoire que le fichier.

J'ai joint en fichiers attachés le brouillon de mon fichier avec les 2 sons.

Quelqu'un aurait-il une proposition pour réaliser ces 2 actions ?

D'avance merci et un excellent week-end.

Fab

 

[Staple1600]

Compte à rebours (exercices sériels) et sons pour lancer/arréter l'essai.

Bonsoir à tous


Désolé, mais cela me pique trop les yeux.
Tu voulais plutôt écrire:
Code pour compte à rebours (exercice en séries) et sons pour lancer et arrêter l'essai.

Maintenant pour ta question, je laisse mes petits camarades de jeu te filer un coup de main.

 

[MichD]

Re : Code pour compte à rebours (exercice en séries) et sons pour lancer et arréter l

Bonjour,

Pour la boucle selon la valeur en durée de chaque cellule de chaque ligne du tableau B2:B16

En F1 s'affiche le compte à rebours pour chaque contenu de chaque cellule de la plage.

Reste qu'à faire jouer un son chaque fois que la cellule F1 = 0 ou la valeur d'une cellule en colonne B
Attention, un délai d'une seconde est très court... si tu ne veux pas que l'affichage en F1 saute des chiffres,
les sons doivent être courts!

Je ne voudrais pas t'enlever tout le plaisir...! ;-)

Sub test()
Dim T As Double, Rg As Range, R As Range, C As Range
With Worksheets("Sheet1")
    Set Rg = .Range("B2:C" & .Range("B" & .Rows.Count).End(xlUp).Row)
End With

For Each R In Rg.Rows
    For Each C In R.Cells
        Worksheets("Sheet1").Range("F1") = C.Value
        T = Timer + C.Value
        'Regarde la progression dans la fenêtre Exécution
        'pour afficher cette fenêtre : Raccourci clavier Ctrl + G
        Debug.Print C.Address & "  " & Range("F1").Value
       Do While T > Timer
            Range("F1") = (T - Timer) Mod C.Value
            DoEvents
        Loop
    Next
Next       
End Sub

 

[Fab117]

Re : Compte à rebours (exercices sériels) et sons pour lancer/arréter l'essai.

Bonsoir à tous


Désolé, mais cela me pique trop les yeux.
Tu voulais plutôt écrire:
Code pour compte à rebours (exercice en séries) et sons pour lancer et arrêter l'essai.

Maintenant pour ta question, je laisse mes petits camarades de jeu te filer un coup de main.

Salut, en fait, je voulais écrire "lancer et arréter les séries" mais je n'ai pas eu assez de caractères à dispsosition

 

[Staple1600]

Re : Code pour compte à rebours (exercice en séries) et sons pour lancer et arréter l

Bonjour à tous


Juste de passage pour remercier Fab117 d'avoir apporter cette dernière précision

Mais au fait est-ce la proposition de MichD solutionne ta question ?

 

[Fab117]

Re : Code pour compte à rebours (exercice en séries) et sons pour lancer et arréter l

Bonjour MichD,
Un grand merci pour ton aide.
Ca fonctionne presque parfait par raport à ce que j'aimerais avoir.
En fait, je veux le décompte dans la cellule "A2" et non "F1".
J'ai donc juste changé les 3 "F1" de ton aide par 3 "A2".

Par contre, je n'arrive pas à le faire commencer par le délai initial qu'il doit prendre en "F1".
J'ai essayé de sortir la boucle une partie de ton code:
' Délai initial
C.Value = Range("F1")
T = Timer + C
Debug.Print Délai.Address & " " & Range("A2").Value
Do While T > Timer
'Range("F1") = (T - Timer) Mod C.Value
Range("A2") = (T - Timer) Mod C.Value
DoEvents
Loop

Mais ça ne fonctionne pas.
Pourrais-tu stp m'aider encore sur ce point ?

Bon dimanche.

Fab

 

[MichD]

Re : Code pour compte à rebours (exercice en séries) et sons pour lancer et arréter l

Bonjour,

Voici une façon plus simple de procéder pour obtenir ce que tu désires :

'----------------------------------------------
Sub test()
Dim Rg As Range, R As Range, C As Range
Dim S As Long

With Worksheets("Sheet1") 'Nom feuille à adapter
     Set Rg = .Range("B2:C" & .Range("B" & .Rows.Count).End(xlUp).Row)
End With

Range("A2") = ""
For Each R In Rg.Rows
     For Each C In R.Cells
        If C <> "" Then
            S = C.Value
            Do While S > 0
                Délai 1
                Range("A2") = Range("A2") + 1
                Range("F1") = Range("F1") - 1
                DoEvents
                S = S - 1
            Loop
        End If
    Next
Next
End Sub

'=========================
Function Délai(t As Long)
Dim V As Double
V = Timer + t
Do While V > Timer
    DoEvents
Loop
End Function
'----------------------------------------------