Compte à rebours sur formulaire en VBA

Résolu
Luluc -  
 vatfer -
Bonjour à tous,
Je suis un peu débutant en VBA.
J'ai une application excel qui récupère des fichiers par FTP, lit les fichiers pour récupérer des valeurs servant à incrémenter des compteurs statistiques et faire les graphiques jpournaliers pour ces compteurs.
Cette application est exécutée tous les jours autmatiquement dans la planificateur de tâches de Windows.
J'aimerais qu'il soit possible de ne pas lancer la récupération par FTP dans le cas où l'utilisateur ouvre le classeur manuellement car les fichiers sont gros et le temps de réupération assez long.
Pour cela, je voudrais faire un formulaire avec une zone de texte et deux boutons.
ce formulaire ce lancerait au début de la macro
Dans la zone de texte un compte à rebours de 60 secondes par exemple.
A la fin des 30 secondes, sans action de l'utilisateur, la connexion FTP s'effectue
Un bouton "immédiat" pour annuler le compte à rebours et lancer la connexion immédiatement
Un bouton "annuler" pour annuler la connexion FTP
Je parviens à faire le formulaire avec le compte à rebours, mais durant ce compte à rebours, un clic sur n'impote lequel des deux boutons est totalement inopérant. Je n'ai la main qu'à la fin du compte à rebours.
Comment puis-je régler ce problème ?
Merci d'avance pour votre aide.

3 réponses

Réponse 1 / 3
tech_57
 
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 

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+.
1
Luluc
 
Bonjour,

C'est génial, ça marche nickel.
Merci beaucoup pour ton aide.
0
vatfer31
 
Bonjour tech57 et luluc
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
0
blux Messages postés 27117 Date d'inscription   Statut Modérateur Dernière intervention   3 359
 
duree est le nom de la zone dans laquelle s'affiche la valeur courante du compte à rebours.

Il te suffit donc d'ajouter une zone de texte nommé 'duree' dans ton formulaire.
0
vatfer
 
Merci beaucoup Blux ça fonctionne!
0
Réponse 2 / 3
tech_57
 
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+.
0
luluc
 
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é ?
0
Réponse 3 / 3
blux Messages postés 27117 Date d'inscription   Statut Modérateur Dernière intervention   3 359
 
Salut,

tu peux regarder ici :

https://www.commentcamarche.net/faq/10315-vba-un-timer-une-seconde-tout-simple
0