Temporisation "correcte" sous Excel 2013/2016
Bonjour,
suite à un message récent,
suite à mon passage en Excel 2013,
suite à un essai récent,
il est attesté que la fonction "Sleep" sous l'application "CREPE" (mon jeu de pendu) ne fonctionne pas comme elle devrait, tout du moins sur mon ordinateur.
Pouvez vous faire un test et éventuellement me donner une solution de temporisation simple qui fonctionne quelque soit la version d'Excel et ceci sans être "obligé" d'installé une quelconque "bibliothèque" ou autre ?
J'ai résolu le problème avec un For To Next qui écrit une valeur dans une cellule 10000 fois, mais je ne trouve pas ceci "joli", et oui avec le temps j'aimerais programmé comme un pro !
Merci @ vous et @ bientôt
LouReeD
Le fichier : Lien supprimé par LouReeD
Vous avez vu dhany ?! J'ai trouvé un moyen d'augmenter mes téléchargements !
Bonjour LouReed,
as-tu déjà regardé les possibilités de application.wait ?
HA oui le premier "Sleep" est dans le module "Analyse du jeu"
Sub Analyse(Target)
Dim Cpt As Integer, Trouvé As Boolean, Le_Nom As String
Application.ScreenUpdating = False
For Cpt = Boucle To Len(Le_Mot) - (Boucle - 1)
If UCase(Mid(Le_Mot, Cpt, 1)) = UCase(Target.Value) Then ' on a trouvé une lettre
Sheets(1).Cells([Ligne_de_jeu].Row, Première_Lettre + ((Cpt - 1) * 2)).Value = UCase(Target.Value)
If Trouvé = False Then Points = Points + Int(Première_Lettre / 3) Else Points = Points + Int(Première_Lettre / 4)
Trouvé = True
NB_Lettres = NB_Lettres - 1
End If
Next Cpt
Target.Value = ""
If Trouvé = False Then
Points = Points - 1
If Points < 0 Then Points = 0
[Le_Score].Value = Points
Perdu = Mid("Le Jeu Du Pendu", 1, Len(Perdu) - 1)
If Right(Perdu, 1) = " " Then Perdu = Mid("Le Jeu Du Pendu", 1, Len(Perdu) - 1)
Sheets("Jeu").Unprotect
If Len(Perdu) < 4 And Len(Perdu) > 0 Then [Progression_CF].Interior.Color = RGB(255, 0, 0)
If Len(Perdu) < 7 And Len(Perdu) > 3 Then [Progression_CF].Interior.Color = RGB(255, 200, 100)
Sheets("Jeu").Protect
If Len(Perdu) = 0 Then
Sheets("Jeu").Unprotect
[Progression_CF].Interior.Color = xlNone
Sheets("Jeu").Protect
[Progression] = "Vous avez fini !!!"
[Résultat] = "Perdu !"
Partie = False
For Cpt = Boucle To Len(Le_Mot) - (Boucle - 1)
Sheets(1).Cells([Ligne_de_jeu].Row, Première_Lettre + ((Cpt - 1) * 2)).Value = UCase(Mid(Le_Mot, Cpt, 1))
Next Cpt
[Définition].Value = Sheets("Dictionnaire").Cells(Ligne_du_Mot, 4).Value
Application.ScreenUpdating = True
If Points > [Combien] Then
Le_Nom = InputBox("Veuillez entrer votre nom pour la postérité !")
[Qui] = Le_Nom
[Qui_mem] = Le_Nom
[Combien] = Points
[Combien_mem] = Points
[Le_Score] = 0
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkbook.Save
On Error GoTo 0
Application.DisplayAlerts = True
End If
Else
[Progression] = Perdu
Application.ScreenUpdating = True
End If
Else
If NB_Lettres = 0 Then
[Résultat] = "Trouvé !"
Points = Points + Int(Première_Lettre / 2)
[Le_Score].Value = Points
[Définition].Value = Sheets("Dictionnaire").Cells(Ligne_du_Mot, 4).Value
Application.ScreenUpdating = True
Sleep (3500)
Call Début_de_partie
Else
[Le_Score].Value = Points
Application.ScreenUpdating = True
End If
End If
End Sub
Je crois qu'il y en a un autre mais a priori non...
Sous 2013, lorsque l'on trouve un mot, s'il y a une définition, elle devrait s'afficher pendant 3500 millisecondes soit 3.5 secondes mais rien ne se passe... Sous 2016 également....
Merci @ vous
@ bientôt
LouReeD
Acide ! Bravo !
Application.Wait(Now + TimeValue("00:00:04"))
fait que le code reprend "son déroulé" à l'heure de maintenant + 4 secondes car Application.Wait attend en argument une heure exacte d'arrêt "d'arrêt de déroulé de code". Donc ici l'heure on VBA lit la ligne + 4 secondes.
Merci encore, je vais de ce pas modifier l'application !
@ bientôt
LouReeD
Et pour ne pas "tricher" sur les téléchargements je supprime le lien vers la page !