none
Compte à rebours sur userform en VBA sous Excel 2003 RRS feed

  • Question

  • 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 dans chaque enregistrement des valeurs servant à incrémenter des compteurs statistiques et faire les graphiques journaliers pour ces compteurs.
    Cette application est exécutée tous les jours automatiquement 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 60 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.

    Voici ce 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.
    Comment puis-je régler ce problème ?
    Merci d'avance pour votre aide.
    mercredi 7 octobre 2009 13:50

Toutes les réponses

  • Bonjour,
    Nous avons à peu près la même problématique de fichier qui se lancent automatiquement et nous avons pu contourner le problème:
    Private StopPrcess as Boolean

    Private Sub CommandButton1_Click() StopPrcess = True SelectAllCampaign = False HomeForm.Hide End Sub Private Sub CommandButton2_Click() 'ThisWorkbook.Close Application.Quit End Sub Private Sub UserForm_activate() StopPrcess = False PauseTime = 10 Start = Timer diff = Start finish = Start + PauseTime While (Start < finish) Start = Timer HomeForm.TimeProgress.Caption = PauseTime + Int(((finish - Start) - PauseTime)) + 1 DoEvents Wend If StopPrcess = False Then perform "all my actions"
    End If End Sub
    Il s'agit là du code d'un formulaire simple contenant:
    un label : TimeProgress
    2 boutons:
    commandbutton1 qui permet d'arrêter le Timer
    commandbutton2 qui permet de fermer le classeur (on s'est trompé de classeur)

    Le formulaire est ouvert à l'ouverture du classeur (appel dans la procédure Workbook_Open

    L'élément important du code est l'appel à la commande DoEvents qui permet de laisser la main dans la boucle.
    XOrangoutan
    • Proposé comme réponse XOrangoutan mardi 20 octobre 2009 14:34
    mardi 20 octobre 2009 14:34