Compte à rebours aléatoire

Le 07/12/2020 à 09:29

Bonjour,

j'utilise une macro en boucle qui commence par un compte à rebours de 1 à 30 secondes.

Sub COMPTE_REBOURS()

Dim f As Integer
Dim Cellule As Range

Heure_Actuelle = TIMER ' "Timer" Sauve le nombre de secondes écoulées depuis minuit

'Initialiser le générateur de nombres aléatoires
'=> Randomize : à ajouter avant d'utiliser Rnd pour obtenir des valeurs complètement aléatoires

Randomize ' Initialize random-number generator.
Nb_Seconde = Int((30 * Rnd) + 1) ' Generate random value between 1 and 30.

Do
       If Int(TIMER - Heure_Actuelle) Mod Nb_Seconde = 0 Then
            f = FreeFile
            Open "C:\Users\XXXX\Desktop\TEST.txt" For Output As #f       ' Ouverture en mode écriture ("output")
            For Each Cellule In Range("A1:A24")
                Print #f, Cellule.Text         ' Ecriture lignes
            Next
            Close f ' Fermeture du fichier
        End If
        DoEvents
Loop

End Sub

Le problème est que ce caractère aléatoire ne se produit qu'une seule fois au lancement de la macro...
Perso je souhaiterai que le côté aléatoire se fasse à chaque boucle...sans avoir à stopper et relancer la macro donc...

Une idée ? Je vous laisse le fichier en pièce jointe au cas où... merci

Le 07/12/2020 à 14:26

Bonjour,

Remplace temporairement

Do
       If Int(TIMER - Heure_Actuelle) Mod Nb_Seconde = 0 Then
            f = FreeFile
            Open "C:\Users\XXXX\Desktop\TEST.txt" For Output As #f       ' Ouverture en mode écriture ("output")
            For Each Cellule In Range("A1:A24")
                Print #f, Cellule.Text         ' Ecriture lignes
            Next
            Close f ' Fermeture du fichier
        End If
        DoEvents
Loop

par ...

Do
       If Int(TIMER - Heure_Actuelle) Mod Nb_Seconde = 0 Then
           Msgbox  " test ..." 
        End If
        DoEvents
Loop

Tu vas remarquer que le compte à rebours aléatoire fonctionne ...

Le délai de 1 seconde est sûrement trop court pour le code à exécuter > il y a des tests à faire ...

Je te laisse t'amuser ...

ric

Le 07/12/2020 à 14:40

Je test ça et reviens vers toi ! Merci

Le 07/12/2020 à 15:19

Alors je viens de tester cela (en prenant en compte ta remarque sur le délais trop court de 1 sec) :

Sub COMPTE_REBOURS()

Dim f As Integer
Dim Cellule As Range

Heure_Actuelle = Timer ' "Timer" Sauve le nombre de secondes écoulées depuis minuit

'Initialiser le générateur de nombres aléatoires
'=> Randomize : à ajouter avant d'utiliser Rnd pour obtenir des valeurs complètement aléatoires

Randomize ' Initialize random-number generator.
Nb_Seconde = Int((45 * Rnd) + 5) ' Generate random value between 5 and 45.

Do
       If Int(Timer - Heure_Actuelle) Mod Nb_Seconde = 0 Then
           MsgBox " test ..." & Nb_Seconde
        End If
        DoEvents
Loop
End Sub

Et franchement ça ne marche pas chez moi !

j'ai même ajouté & Nb_Seconde pour afficher le résultat et en avoir le cœur net...

Je lance la macro elle me sort le chiffre aléatoire généré (ici c'était 17) et ensuite à chaque boucle la fenêtre s'affiche toutes les 17 secondes...elle ne change pas a chaque passage ! Moi je voudrai qu'a chaque boucle le chiffre généré change !

Le 07/12/2020 à 15:54

Bonjour,

Source : https://forum.excel-pratique.com/excel/executer-une-macro-toutes-les-x-secondes-99903#p583207

Adaptation > surveille A2 de la Feuil1 > à adapter au besoin ...

Dim StopBJAR As Boolean

Sub BJAR()

    Static bar%

    nb_seconde = Int((25 - 10 + 1) * Rnd + 10)

    Worksheets("Feuil1").Range("A2") = IIf(bar = 1, "Au revoir !", "Bonjour !")
    bar = (bar + 1) Mod 2
    Application.OnTime Now + TimeSerial(0, 0, nb_seconde), IIf(StopBJAR, "Effacer", "BJAR")
End Sub

Sub ArrêtBJAR()
    StopBJAR = True
End Sub

Sub LancerBJAR()
    StopBJAR = False
    BJAR
End Sub

Sub Effacer()
    Worksheets("Feuil1").Range("A2").ClearContents
End Sub

ric

Le 07/12/2020 à 17:08

Bonjour,

si tu veux que ça change à chaque fois, il faut le mettre dans la boucle :

Do
   Nb_Seconde = Int((45 * Rnd) + 5) ' Generate random value between 5 and 45.
   ' ...

eric

Le 07/12/2020 à 17:09

Bonjour tous,

Ce que je comprends du traitement désiré ...

Tu veux écrire dans le fichier TEST.txt le contenu de A1 à A24 à toutes les X secondes > X étant un temps aléatoire ...

Un essai basé sur le code de feu MFerrand ...

Dim StopBJAR As Boolean
Dim Nb_seconde As Integer

Sub BJAR()

    Static bar%
    Nb_seconde = Int((25 - 10 + 1) * Rnd + 10)
    Call Module1.Traitement
    bar = (bar + 1) Mod 2
    Application.OnTime Now + TimeSerial(0, 0, Nb_seconde), IIf(StopBJAR, "Effacer", "BJAR")
End Sub

Sub ArrêtBJAR()
    StopBJAR = True
End Sub

Sub LancerBJAR()
    StopBJAR = False
    BJAR
End Sub

Sub Effacer()
'''    Worksheets("Feuil1").Range("A2").ClearContents
End Sub

Sub Traitement()
Dim Cellule As Range

      f = FreeFile
      Open "C:\Users\XXXX\Desktop\TEST.txt" For Output As #f       ' Ouverture en mode écriture ("output")
      For Each Cellule In Worksheets("Feuil1").Range("A1:A24")
         Print #f, Cellule.Text         ' Ecriture lignes
      Next
      Close f   ' Fermeture du fichier
End Sub

ric

Le 07/12/2020 à 18:01

Eriiic :

Merci de ton aide !
J'ai donc modifié la macro de test avec ta piste. J'ai donc :

Sub COMPTE_REBOURS()

Dim f As Integer
Dim Cellule As Range

Heure_Actuelle = Timer ' "Timer" Sauve le nombre de secondes écoulées depuis minuit

'Initialiser le générateur de nombres aléatoires
'=> Randomize : à ajouter avant d'utiliser Rnd pour obtenir des valeurs complètement aléatoires

Randomize ' Initialize random-number generator.

Do
 Nb_Seconde = Int((45 * Rnd) + 5) ' Generate random value between 5 and 45.
       If Int(Timer - Heure_Actuelle) Mod Nb_Seconde = 0 Then
           MsgBox " test ..." & Nb_Seconde
        End If
        DoEvents
Loop
End Sub

Résultat :

Je lance la macro, ça me donne bien un chiffre aléatoire je ferme la fenêtre avec OK et la ça me redonne certes des chiffres différents mais plus aucune temporisation...juste des chiffre aléatoire en boucle....

Le 07/12/2020 à 18:05

Ric :

Oui ma macro doit fonctionner "non stop" et dans l'ordre :

Sortir une valeur aléatoire qui sert de temporisation...si par exemple 22....
Après 22 secondes....copie des valeurs vers le txt puis sortie d'une autre valeur aléatoire...par exemple 35....
Après 35 secondes...copie des valeurs vers le txt ............

Par contre j'insiste, la macro je dois la lancer une fois et ensuite elle tourne non stop sans aucune intervention de ma part !

Le 07/12/2020 à 18:20

Bonjour,

Si tu lances "LancerBJAR" > ce devrait être le cas > ne jamais arrêter > sauf manuellement via "ArrêtBJAR" ...

ÉDIT : j'ai oublié de mentionner > à placer dans le Module1

Les quelques tests que j'ai faits = fonctionne bien ...

ric

Le 07/12/2020 à 19:44

Salut Oly,
Salut l'équipe,

Basé sur Application.OnTime, bien sûr...
Par contre, je ne comprends pas très bien l'usage de DO...LOOP..

J'ai pu mesurer, sur [A1:A24], comme dans ton exemple, que le temps d'écriture sur "TEST.txt" était négligeable : tu pourrais alors changer les paramètres de RandBetween en fonction du volume de données à écrire.

Public Sub SaveFile()
'
Dim rCel As Range, iSec%
'
With Worksheets("BDD")
    f = FreeFile
    Open "C:\Users\Utilisateur\Downloads\TEST.txt" For Output As #f
    For Each rCel In .Range("A1:A24")
        Print #f, rCel.Value
    Next
    Close f
    '
    iSec = WorksheetFunction.RandBetween(5, 30)
    Application.OnTime Now + TimeValue("00:00:" & CStr(iSec)), "SaveFile", , True
End With
'
End Sub

Je constate aussi que, dans "TEST.txt", ne subsistent que les dernières entrées et non l'ensemble des données depuis l'ouverture du fichier : il y a sans doute une instruction manquante pour ajouter les nouvelles données aux anciennes. J'avoue ne pas avoir cherché...

4oly.xlsm (15.39 Ko)


A+

Le 14/12/2020 à 14:10

Désolé de la réponse tardive (Pb de box...) ! Écoutez merci à tous pour vos réponse..je n'ai pas tout testé mais la macro de Ric est parfaite pour mon projet !

Encore merci à la communauté vous êtes des chefs !

Rechercher des sujets similaires à "compte rebours aleatoire"