[Résolu] Problème avec compte à rebours

[Lone-wolf]

Bonsoir à tous,

après plusieures tentative, je me retourne vers vous, pour résoudre mon problème. J'ai essaié d'inserer un compte à rebours dans la shape(nom: img), mais au moment où je change le texte dans la cellule orange, celui-ci se remet au début; alors je l'ai supprimé.

J'avais écrit la boucle comme ceci:

Sub Compteur()
Dim i%

For i = 30 To 0 Step -1
Sheets(1).Shapes("img").TextFrame.Characters.Text = j
t = Timer + 1: Do Until Timer > t: DoEvents: Loop
Next i
If Sheets(1).Shapes("img").TextFrame.Characters.Text = 0 Then: _
Sheets(1).Range("e3").Value = "Désolé, vous avez perdu.": _
Exit Sub

For i = 1 To 1
Sheets(1).Range("e3") = "Le juste prix de la vitrine est de "
t = Timer + 2.5: Do Until Timer > t: DoEvents: Loop
Sheets(1).Range("e3").Value = Sheets(1).Range("l1").Value
Sheets(1).Range("e3").NumberFormat = "0 €"
Next i

End Sub

Je ne sais pas comment faire pour le rendre indépendant des modifications apportées dans la cellule F9.


Merci pour votre aide.



A+

 

[fanfan38]

Re : Problème avec compte à rebours

Bonjour
Ton application etant protégée... Nous ne pourrons rien pour toi...
A+ François

 

[Lone-wolf]

Re : Problème avec compte à rebours

Bonjour François,

Ton application etant protégée...

Comment ça? Je ne comprends pas.


A+

 

[camarchepas]

Re : Problème avec compte à rebours

Bonjour Lone Wolf,

Le fichier s'ouvre parfaitement , pas de problème peut être dû à l'extension XLS.

Que veux-tu faire exactement , faire clignoter l'étoile , c'est cela ?

 

[fanfan38]

Re : Problème avec compte à rebours

Bonjour
Excuse j'étais pas bien réveillé...
A+ François

 

[Lone-wolf]

Re : Problème avec compte à rebours

Bonsoir François, camarchepas,

@François: pas de problème, tu es tout excusé.

@camarchepas: non, pas la faire clignoter; mais afficher un compte à rebours de 30 à zéro pendant le déroulement du jeu. Dans le fichier joint, je m'y suis pris autrement; mais il y a un problème d'écriture de la macro concernant les textes qui doivent s'afficher dans la zone bleu. Le bouton GO! Sert à activer le chronomètre.


A+

 

[Lone-wolf]

Re : Problème avec compte à rebours

Bonjour à tous,

problème résolu, voici le code pour ceux qui serait interéssés.

Dans un module standard:

Public compte
Public run As Boolean

Sub decompte()
compte = 30
If run Then
run = False
compte = compte - 1
Sheets(1).Shapes("img").TextFrame.Characters.Text = compte
End
End If
run = True
chrono
End Sub

Sub chrono()
Static test As String
Dim cel, c As Range
Set cel = Feuil1.[F9]
Set c = Feuil1.[L1] 'Numéro à trouver
test = IIf(cel > c, "C'est moins !", "C'est plus !")
If cel <> "" Then Feuil1.[E3] = test

If cel.Value = c.Value Then
[E3].Value = "C'est gagné !"
t = Timer + 2: Do Until Timer > t: DoEvents: Loop

[E3].Value = "Le juste prix de la vitrine est bien"
t = Timer + 2: Do Until Timer > t: DoEvents: Loop

[E3].Value = c.Value
[E3].NumberFormat = "0 €"
run = False
Sheets(1).Shapes("img").TextFrame.Characters.Text = 0
End
End If

Sheets(1).Shapes("img").TextFrame.Characters.Text = compte
If compte = 0 Then
[E3].Value = "Désolé, vous avez perdu."
t = Timer + 2: Do Until Timer > t: DoEvents: Loop
[E3].Value = "Le juste prix de la vitrine est de"
t = Timer + 2: Do Until Timer > t: DoEvents: Loop
[E3].Value = c.Value
[E3].NumberFormat = "0 €"
Exit Sub
End If

On Error Resume Next
Application.OnTime Now + TimeValue("00:00:01"), procedure:="chrono", schedule:=run
compte = compte - 1

End Sub

Dans la feuille:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [F9]) Is Nothing Then: [F9].Select
If [F9] = "" Then Range("e3", "i3").ClearContents
End Sub

Très bon weekend

 

[Lone-wolf]

Re : [Résolu] Problème avec compte à rebours

Rebonsoir à tous,


Mise à jour du code:

Public compte
Public run As Boolean

Sub decompte()
compte = 61
If run Then
run = False
End
End If
run = True
Call chrono
End Sub

Sub chrono()
Static test As String
Dim cel, c As Range
Set cel = Feuil1.[F9]
Set c = Feuil1.[L1] 'Numéro à trouver
test = IIf(cel > c, "C'est moins !", "C'est plus !")

If cel <> "" Then Feuil1.[E3] = test

If cel.Value = c.Value Then
[E3].Value = "C'est gagné !"
t = Timer + 2: Do Until Timer > t: DoEvents: Loop

[E3].Value = "Le juste prix de la vitrine est bien"
t = Timer + 2: Do Until Timer > t: DoEvents: Loop

[E3].Value = c.Value
[E3].NumberFormat = "0 €"
Call aleatoire
End
End If


If compte = 0 Then
[E3].Value = "Désolé, vous avez perdu."
t = Timer + 2: Do Until Timer > t: DoEvents: Loop
[E3].Value = "Le juste prix de la vitrine est de"
t = Timer + 2: Do Until Timer > t: DoEvents: Loop
[E3].Value = c.Value
[E3].NumberFormat = "0 €"
run = False
Sheets(1).Shapes("img").TextFrame.Characters.Text = 0
Exit Sub
Call aleatoire
End If

Application.OnTime Now + TimeValue("00:00:01"), procedure:="chrono", schedule:=run
compte = compte - 1
Sheets(1).Shapes("img").TextFrame.Characters.Text = compte

ActiveWorkbook.RefreshAll
End Sub

Sub aleatoire()
'Inscription d'un nombre aléatoire entre 10000 et 30000
Set Dico = CreateObject("Scripting.dictionary")
Randomize
While Dico.Count < 1
 x = Int((20000 * Rnd()) + 10000)
 Dico(x) = x
Wend
[L1].Resize(, 1) = Dico.keys
End Sub

Sub CRebours()
Dim i As Long
For i = 5 To 0 Step -1
Sheets(1).Shapes("bulle").TextFrame.Characters.Text = i
t = Timer + 1: Do Until Timer > t: DoEvents: Loop
Next i
Call decompte
End Sub

Bonne nuit