Compte à rebours sur formulaire en VBA
Résolu/Fermé
A voir également:
- Compte à rebours sur formulaire en VBA
- Créer un compte instagram sur google - Guide
- Créer un compte google - Guide
- Créer un compte gmail - Guide
- Supprimer compte instagram - Guide
- Gmail connexion autre compte - Guide
3 réponses
Re,
je crois que ton erreur vient de là
Application.Wait (Now + TimeValue("0:00:01"))
la methode Wait suspend l'execution de la macro jusqu'à une heure donnée. c'est pas ce que tu veux.
utilise plutot une boucle avec un timer.
Voici comment ça marche:
1) ouvre un module et ecris ces ligne tout en haut pour déclarer des variables publiques
2)Dans ce meme module tu ecris cette procedure
3)dans le code du button Immediat tu ecris
et enfin la procedure WorkBook_open devient
Si je ne me suis pas trompé, tu auras le résultat escompté. A+.
je crois que ton erreur vient de là
Application.Wait (Now + TimeValue("0:00:01"))
la methode Wait suspend l'execution de la macro jusqu'à une heure donnée. c'est pas ce que tu veux.
utilise plutot une boucle avec un timer.
Voici comment ça marche:
1) ouvre un module et ecris ces ligne tout en haut pour déclarer des variables publiques
Option Explicit Public Ftp, Rebours
2)Dans ce meme module tu ecris cette procedure
Sub affiche_recup_fichiers() Dim PauseTime, Start, Temps Ftp = True Rebours = 60 Start = Timer PauseTime = Rebours temps = Timer + 1 recup_fichiers.Show 0 recup_fichiers.duree.Value = Rebours Do While Timer < Start + PauseTime If Timer > temps Then temps = temps + 1 Rebours = Rebours - 1 recup_fichiers.duree.Value = Rebours End If DoEvents ' Donne le contrôle à d'autres processus. If Rebours = -1 Then Exit Do If Ftp = False Then Exit Do Loop recup_fichiers.Hide If Ftp = False Then MsgBox "Opération annulée" Else MsgBox "La récuration va démarrer" Call RecupFtp() End If End Sub
3)dans le code du button Immediat tu ecris
Sub Immediat_Click() Rebours = -1 End Sub
et enfin la procedure WorkBook_open devient
Sub Workbook_open() Call affiche_recup_fichiers End Sub
Si je ne me suis pas trompé, tu auras le résultat escompté. A+.
Bonjour,
Dans la boucle qui affiche le compte à rebours, il faut placer l'instruction DoEvents.
Cette instruction permet de traiter des évènements comme des clics sur les boutons...
Voir l'aide pour plus de détails.
A+.
Dans la boucle qui affiche le compte à rebours, il faut placer l'instruction DoEvents.
Cette instruction permet de traiter des évènements comme des clics sur les boutons...
Voir l'aide pour plus de détails.
A+.
bonjour tech_(è et merci pour ta réponse.
En fait, j'ai mis l'instruction DoEvents sinon la mise à jour de l'affichage du compte à rebours ne se faisait même pas, il exécutait le compte à rebours en n'affichant que la valuer initiale.
Voici un extrait du code que j'ai écrit :
Sub Workbook_open()
ftp = True
recup_fichiers.Show
For rebours = 60 To 0 Step -1
If ftp = False Then Exit For
recup_fichiers.duree.Value = rebours
Application.Wait (Now + TimeValue("0:00:01"))
DoEvents
Next
recup_fichiers.Hide
...
...
...
If ftp = True Then
Call RecupFtp()
End If
...
...
End sub
Code du userform "recup_fichiers"
Sub Immediat_Click()
rebours = 1
End Sub
Sub annuler_Click()
ftp = False
End Sub
Le userform s'affiche, le compte à rebours se décrémente correctement, mais que je clique sur le bouton "Immédiat" ou sur le bouton "Annuler" rien ne se passe, le compte à rebours continue.
Peux-tu me dire où je me suis planté ?
En fait, j'ai mis l'instruction DoEvents sinon la mise à jour de l'affichage du compte à rebours ne se faisait même pas, il exécutait le compte à rebours en n'affichant que la valuer initiale.
Voici un extrait du code que j'ai écrit :
Sub Workbook_open()
ftp = True
recup_fichiers.Show
For rebours = 60 To 0 Step -1
If ftp = False Then Exit For
recup_fichiers.duree.Value = rebours
Application.Wait (Now + TimeValue("0:00:01"))
DoEvents
Next
recup_fichiers.Hide
...
...
...
If ftp = True Then
Call RecupFtp()
End If
...
...
End sub
Code du userform "recup_fichiers"
Sub Immediat_Click()
rebours = 1
End Sub
Sub annuler_Click()
ftp = False
End Sub
Le userform s'affiche, le compte à rebours se décrémente correctement, mais que je clique sur le bouton "Immédiat" ou sur le bouton "Annuler" rien ne se passe, le compte à rebours continue.
Peux-tu me dire où je me suis planté ?
blux
Messages postés
26545
Date d'inscription
dimanche 26 août 2001
Statut
Modérateur
Dernière intervention
22 décembre 2024
3 318
7 oct. 2009 à 13:49
7 oct. 2009 à 13:49
Salut,
tu peux regarder ici :
https://www.commentcamarche.net/faq/10315-vba-un-timer-une-seconde-tout-simple
tu peux regarder ici :
https://www.commentcamarche.net/faq/10315-vba-un-timer-une-seconde-tout-simple
9 oct. 2009 à 11:52
C'est génial, ça marche nickel.
Merci beaucoup pour ton aide.
4 août 2010 à 23:56
Le forum date un peu mais j'espère que l'un de vous 2 pourra me répondre.
Je me suis inspiré de ce code pour faire un compte à rebours, par contre VBA ne reconnait pas
le terme duree dans
MonFormulaire.duree.value
d'ailleurs je ne connaissais pas cette fonction, vous pouvez m'expliquer?
un gd merci
5 août 2010 à 10:02
Il te suffit donc d'ajouter une zone de texte nommé 'duree' dans ton formulaire.
6 août 2010 à 16:24