Compte à rebours personnalisé

Le 13/10/2019 à 22:12

Bonjour à vous toutes et tous,

J'estime avoir un niveau moyen d'Excel, mais complètement nul en VBA.

Je suis en train de faire un fichier de scrabble ludique. L'idée consiste en gros à retrouver des mots avec les lettres mélangées et une 'correction automatique' avec la fonction 'si' et mise en forme conditionnelle avec vrai ou faux.

Mon fichier se divise en plusieurs feuilles. Chaque feuille contient le même type de mise en page, c-à-d:

Colonne C = les tirages par ordre alphabétique

Colonne E = là où le joueur doit taper sa réponse

Colonne F = là où il y a la correction automatique avec la fonction si et mfc

=si(e5=z5;"Super, tu maitrises !";"Non, ce tirage est à revoir!"

Colonne Z = les réponses

Il n'y a rien en colonne A, et j'aimerais à côté de chaque tirage de mot, avoir un compte à rebours personnalisé en seconde avec les propriétés suivantes.

Le compte à rebours est de 15 secondes, qui s'active quand le joueur sélectionne la plage du mot qu'il doit taper (cellule E qui correspond au tirage en ligne C) et j'aimerais bien suivre une légende de couleur en fonction du temps qui lui reste (plus précisément: vert de 15 à 11, jaune de 10 à 7, orange de 6 à 3 et rouge de 3 à 0".

A 0, une boite de dialogue qui apparait et averti le joueur que le temps imparti est écoulé, et l'invite à mémoriser ce tirage... Avec un simplement bouton de confirmation "ok".

Fatalement, le compte à rebours du tirage du dessus ne doit pas dépendre de celui du dessous, il n'est dépend que là où se place le joueur dans la colonne E...

Donc, pour résumer:

  • A5 compte à rebours de 15 secondes
  • A6 compte à rebours de 15 secondes
  • B5 ligne vide,
  • B6 ligne vide
  • C5 tirage en texte simple
  • C6 tirage en texte simple
  • D5 le joueur veut taper sa solution, le compte à rebours en A5 se déclenche en respectant les couleurs mentionnées
=> dans les délais, réponse bonne: le compte à rebours s'arrète

=> hors délais: boite de dialogue, remise à 15 secondes

- D6 le joueur veut taper sa solution, le compte à rebours en A5 et arrêté, mais le compte à rebours en A6 s'active à son tour, respectant le même code couleur...

=> mêmes scenarii en terme d'action que pour le cas précédent

  • E5 = correction automatique instantanée avec mfc et fonction si
  • E6 : idem même chose...

Je ne sais pas trop si cela est techniquement réalisable. L'idéal pour moi est qu'une personne m'explique un code pouvant respecter les critères ci-dessous, pour deux lignes (A5, A6). Et, je serai normalement apte à comprendre les différentes variables et les appliquer toutes mes cellules de mes différentes feuilles, de mes différents fichiers...

Résumé de la demande: compte à rebours de 15 secondes avec dégradé de couleurs en fonction du temps restant en A5 et activé quand on veut noter du texte en D5. Idem pour A6...D6, etc... mais compte à rebours non liés entre eux.

Je joins un fichier Excel dans tous les cas pour mieux comprendre.

15tirages-7-lettres-ods-8-uniq-jeux-interactifs-lr.xlsx (84.63 Ko)

Merci énormément

Lucrob

Le 14/10/2019 à 06:06

Salut Lucrob,

je te livre ton fichier alors qu'il reste des choses à faire.

Ne maîtrisant pas du tout ce foutu ON TIME, je n'arrive pas à terminer.

Teste déjà ceci : tu diras ce que tu en penses...

Les MFC et le code (module 'ThisWorkbook') s'appliquent déjà sur toutes les feuilles.

A+

8lucrobscrabble.xlsm (103.68 Ko)
Le 14/10/2019 à 07:04

Bonjour,

Une piste pour le chrono, après, je ne vois pas trop où se trouve la grille !

Pour le test, lancer la Sub() "Test" et regarder en cellule A1 de la feuille active. Le fait que la sub récursive ait des modifs à faire en cellule A1 peut générer un petit décalage dans l'égrainement des secondes :

Sub test()

    Chrono 15

End Sub

Sub Chrono(I As Integer)

    Dim Couleur As Integer

    Select Case I

        Case 0 To 3: Couleur = 3
        Case 4 To 7: Couleur = 45
        Case 8 To 11: Couleur = 27
        Case 12 To 15: Couleur = 4

    End Select

    Range("A1").Value = Format(I / 86400, "hh:mm:ss")
    Range("A1").Interior.ColorIndex = Couleur

    If I <= 0 Then

        MsgBox "C'est fini !"
        Range("A1").Value = ""
        Range("A1").Interior.ColorIndex = -4142
        Exit Sub

    End If

    'récursive
    Application.OnTime Now + TimeValue("00:00:01"), "'Chrono " & I - 1 & "'"

End Sub
Le 14/10/2019 à 10:12

Bonjour,

Ce n'est pas une grille de scrabble classique a proprement dite, mais diverses listes de mots à deviner éparpillées sur diverses feuilles.

Le chrono situé en A1 comme dans le code avec respect des couleurs demandées. Merci beacoup.

Comment faire pour le mettre en A5 et que surtout, il s'enclenche uniquement en modifiant en texte (n'importe lequel) la ligne cellule correspondante (en l'occurence: E5) ?

Et que forcément, passer en E6, le chrono en A6 s'enclenche mais que le chrono en A5 soit arrêté (mise en pause), là où le joueur tapait en E5. Est-ce que la touche ENTER peut être la commende enclencheuse de l'événement (puisqu'on passe ainsi à la cellule suivante?) ?

Merci de votre aide, précision, en espérant avoir mieux éclairci ma demande.

Lucrob

Le 14/10/2019 à 16:41
curulis57 a écrit :

Salut Lucrob,

je te livre ton fichier alors qu'il reste des choses à faire.

Ne maîtrisant pas du tout ce foutu ON TIME, je n'arrive pas à terminer.

Teste déjà ceci : tu diras ce que tu en penses...

Les MFC et le code (module 'ThisWorkbook') s'appliquent déjà sur toutes les feuilles.

A+

Merci beaucoup, c'est excellent comme ça.

J'ai simplement utilisé le enter flèche du bas pour mettre les 15 partout, et peaufiner où c'est descendu parfois à 14...

Simple question. Comment je peux faire pour rajouter maintenant une feuille qui ne sera pas affectée par la macro générale ?

Merci

Le 15/10/2019 à 06:06

Salut Lucrob,

Dans 'ThisWorkbook', le code s'applique en standard sur toutes les feuilles.

Il faut donc cibler simplement les feuilles en fonction de ce que tu veux faire.

Soit,

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'
If Sh.Name <> "Tout liste simple" Then
    On Error Resume Next
    '
    Application.OnTime Now + TimeValue("00:00:01"), "Rebours", , False
    If Not Intersect(Target, Range("E:E")) Is Nothing Then
    '...
'
End Sub

soit,

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'
Select Case Sh.Name
    Case "Tout liste simple"
        '...
    Case "TrucMuche"
        '...
    Case Else
        On Error Resume Next
        '
        Application.OnTime Now + TimeValue("00:00:01"), "Rebours", , False
        If Not Intersect(Target, Range("E:E")) Is Nothing Then
            '...
End Select
'
End Sub

A+

Le 15/10/2019 à 14:03

Hello,

Merci curulus !

Simple question qui m'intrigue, je ne sais pas d'où ça peut venir.

Je m'entraine, je tape la bonne réponse, la première réponse ok, chrono aussi. Mais les suivants, je perds des secondes, plus d'une seconde parfois quand je valide avec ENTER. Comment cela se fait-il ? Parfois en validant la bonne réponse en passant à la ligne du dessous, le décompte va de -3 en -3, et parfois de -2 à -2... comment faire pour que ça aille en seconde?

NB/ C'est possible que je sois sur un serveur interne et que donc ça aille seconde par seconde, mais qu'elles ne s'affichent pas. Je vais tester ça chez moi pour voir si la problématique est identique…

Le 15/10/2019 à 15:19

Bonjour,

Essais de compter 1 000 000, 2 000 000, 3 000 000 et ainsi de suite tout ça en disant, entre les millions, "est-ce que je compte bien en seconde" donc, 1 000 000 "est-ce que je compte bien en seconde" 2 000 000 "est-ce que je compte bien en seconde" 3 000 000 "est-ce que je compte bien en seconde" 4 000 000 "est-ce que je compte bien en seconde", etc... Là, tu vois qu'un décalage se crée par rapport à ta montre car tu es obligé de citer la phrase entre chaque seconde (puisqu'on estime que de dire 1 000 000 prend environ une seconde) et bien, c'est exactement pareil pour le compilateur, plus il a de chose à faire entre deux appels de OnTime, plus il y a de décalage d'où mon :

Le fait que la sub récursive ait des modifs à faire en cellule A1 peut générer un petit décalage dans l'égrainement des secondes

Le 15/10/2019 à 15:27

Il n'y a aucune solution pour contrer cela , niveau décalage.. ?

Agrandir le temps en seconde n'y ferait rien ?

Merci.

Le problème vient de mon PC perso aussi, pas du PC du bureau. C'est donc un souci 'Excel', donc...

Le 15/10/2019 à 15:29

M'étonnerait, à ce point...

Comme je te l'écrivais, je ne domine pas ON TIME et il m'a fallu du temps pour comprendre le ouistiti.

Je sais qu'il reste des bugs.

Je dois encore regarder de plus près.

A+

Le 15/10/2019 à 15:38

Bonjour,

Je me fais cette remarque: le code actuel est donc récursif ? Si oui, c’est donc là d’où vient le décalage...?

Après renseignements à l’instant, je vois qu’il existe « l’iterative ». Est ce que Excel connait ce mode de raisonnement? Est-il possible d’adapter ça avec de l’itération plutot que de la récursivite ?

Est-ce que le mode de déclenchement de la cellule (cellule contour en vert, et enter pour stopper et enclenche la suivante) c’est de la récursivité qui peut causer le souci ? Si oui, quel autre mode alternatif est-il possible pour un chrono marche/stop ?

Merci énormément déjà pour le travail fourni. Si vous n’y arrivez pas, ne vous cassez pas la tête pour ça. C’est juste un projet que j’ai soumis comme « service » ou « défi » aux personnes qui s’y connaissent là dedans... Je suis nul part dans la programmation.

Merci de vos réponses, explications, et de votre implication jusqu’à présent.

Le 16/10/2019 à 00:03

Salutations,

Dans le cas où résoudre ce problème de récursivité serait compliqué pour vous tous,

J'ai prévu un plan B à l'instant:

Faire un unique timer pour chaque page; adapté au nombre de tirage qu'il y a dans la colonne C, sachant que j'estime qu'il faille un délai de 10 secondes pour trouver un unique tirage, arrondi à la minute la plus proche pour chacune des pages.

Pour vous faciliter la vie, sur le fichier joint: j'ai indiqué le nombre de caractères occupé en ligne C via la fonction basique nbval en A1 (fond jaune). !! Les anciennes macros sont toujours activées. Elles n'ont donc plus aucun intérêt si on penche sur mon plan B

J'aimerais bien alors dans ce cas avoir un compte à rebours avec boutons commencer / arrêter / redémarrer (reset du compteur), toujours avec les mêmes types de couleur mais dans un pourcentage de temps. En d'autres termes: fond vert pour les 40% du temps maximum, fond jaune pour 41% à 59%, orange de 60 à 89%, et rouge de 90% à 100%.

Je pense que le format de ces comptes à rebours sont des formes auxquelles on assigne des macros, soit temps et rôles des boutons. Je me chargerai moi même de les mettre en page ...

Existe-t-il un procédé qui permet de dire que lorsque toute les conditions en ligne F du fichier sont vraies (mfc en vert si vrai) le compte à rebours s'arrête automatiquement avec un boite de dialogue "La série est terminée." + précision du temps pris (=temps d'origine - le temps qui reste = temps pris) ?

Si possible, un compteur qui calcule en hh:mm:ss,00 , autrement dit, comprend les centièmes de secondes.

Merci de m'indiquer la marche à suivre et de mettre les constantes en évidence pour une feuille, afin que je puisse voir les variables et tenter de petit à petit comprendre le schmilblick qu'est la VBA. Et que je puisse appliquer de manière autonome les différentes démarches. Je suis un exécutant...

Je ne sais pas si cela convient pour vous ? Offre qui peut être soumise à un refus.. Tant mieux si quelqu'un veut bien m'aider à finaliser ce projet, et à de la pédagogie et du temps pour que je puisse comprendre... Un défi à relever pour vous )

La sphère des amateurs.trices assidu.e.s du Scrabble vous remercie d'avance,

Au plaisir de vous relire,

Lucrob

9liste-ods8-7-lettres-lr.xlsm (132.24 Ko)
Le 17/10/2019 à 23:47

Bonjour,

J'ai tenté de me créer moi même un compte à rebours sur un fichier nouveau, pour test et tenter de comprendre

J'ai a 90% compris le principe de la structure, mais gros problème dans ce que j'ai fait:

une zone de texte qui affiche le compte à rebours, un bouton marche, un bouton arrêt. Couleurs.

Le hic c'est que dès que je lance sur le bouton "marche", il n'y a qu'une seule seconde qui défile, et pas le chrono entier.

Serait-ce possible d'y jeter un coup d'oeil et de repérer mon erreur ?

Voici le code:

Sub marche()
Application.OnTime Now + TimeValue("00:00:01"), "nexttick"
End Sub

Sub nexttick()
Feuil1.Range("B1").Value = Feuil1.Range("B1").Value - TimeValue("00:00:01")
If Feuil1.Range("B1") = 0 Then Exit Sub
If Feuil1.Range("B1").Value <= TimeValue("00:59:59") Then
Feuil1.Shapes("Text Box 1").Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
    If Feuil1.Range("B1").Value <= TimeValue("00:29:59") Then
    Feuil1.Shapes("Text Box 1").Fill.ForeColor.RGB = RGB(255, 255, 0)
    End If
    If Feuil1.Range("B1").Value <= TimeValue("00:14:59") Then
    Feuil1.Shapes("Text Box 1").Fill.ForeColor.RGB = RGB(255, 165, 0)
    End If
    If Feuil1.Range("B1").Value <= TimeValue("00:04:59") Then
    Feuil1.Shapes("Text Box 1").Fill.ForeColor.RGB = RGB(255, 255, 0)
    End If
End Sub

Sub arrêt()
On Error Resume Next
Application.OnTime Now + TimeValue("00:00:01"), "nexttick", , False

End Sub

Code pas vraiment économique, sans doute, mais je le comprends assez facilement de quoi il est basé et son fonctionnement. Très certainement améliorable.

Merci, bonne fin de semaine à vous toutes et tous

Lucrob

Rechercher des sujets similaires à "compte rebours personnalise"