Progressbar & Timer

Bonjour le forum !

Je vais essayer d'être le plus clair possible

J'ai un classeur qui sera (une fois finit) mis sur le réseau de mon entreprise. Je veux éviter le problème du classeur déjà ouvert par un autre utilisateur ! C'est pourquoi j'ai mis dans le code un "timer" qui au bout d'un temps définit enregistre et ferme le classeur. Le problème c'est qu'on a aucune notion du temps, c'est pourquoi je voudrais, sur la feuil MENU adapter la PROGRESSBAR afin de visualiser simplement le temps qu'il reste avant la clôture ! J'ai déjà épuisé tous les forums dispo mais je ne trouve rien qui me convienne Un grand merci pour votre future aide !

PS: l’exécution de la progressebar ne doit pas empêcher d'utilisation du classeur

Bonjour,

Pour pouvoir voir le décompte de temps, il faut qu'un événement se produise donc, avec OnTime toutes les x minutes ou x secondes selon ton choix !

Un exemple avec le code ci-dessous qui peut être appelé à l'ouverture du classeur (Sub "Decompte()"). Dans mon exemple, le décompte se fait toutes les 5 secondes "Intervalle = Seconde * 5" et cet "Intervalle" est retranché à l'heure, sitôt que l'heure devient négative, le temps est écoulé (si c'est l'heure qui est choisie comme durée d'ouverture) donc, enregistrement et fermeture (là, c'est à toi de gérer dans le code). La Sub "Timer()" est récursive. Pour voir le décompte, voir la cellule A1 de la feuille active :

Dim Heure As Single
Dim Minute As Single
Dim Seconde As Single
Dim Texte As String
Dim Intervalle As Single

Sub Decompte()

    Heure = 1 / 24
    Minute = Heure / 60
    Seconde = Minute / 60

    'Intervalle = Minute * 10 '<--- mise à jour toutes les 10 minutes

    'utilisé ici pour que tu puisses voir le décompte en A1 de la feuille active
    Intervalle = Seconde * 5 '<--- mise à jour toutes les 5 secondes

    Timer

End Sub

Sub Timer()

    Texte = "Il reste " & Format(Heure, "hh:mm:ss")

    Heure = Heure - Intervalle

    Range("A1").Value = Texte

    If Heure < 0 Then

        MsgBox "C'est fini !"
        'ici enregistrement du classeur et fermeture
        '...
        Exit Sub

    End If

    Application.OnTime Now + TimeValue(Format(Intervalle, "hh:mm:ss")), "Timer"

End Sub

@Theze Je ne comprend pas vraiment ta réponse ... En tout cas voilà le code qui se trouve dans un module standard, ce que je voudrais c'est :

Sheets("MENU").ProgressBar1.Min = Now

Sheets("MENU").ProgressBar1.Max = RunWhen

Sheets("MENU").ProgressBar1.Value = Now (de manière dynamique de façon à faire évoluer le progressbar)

Option Explicit
Public RunWhen As Date
Sub FermerWbk()
  ThisWorkbook.Close SaveChanges:=vbYes
End Sub

Sub StartTimer()
  RunWhen = Now + TimeValue("01:00:00")
  Application.OnTime RunWhen, "FermerWbk"
End Sub
Sub StopTimer()
  On Error Resume Next
  Application.OnTime EarliestTime:=RunWhen, Procedure:="FermerWbk", Schedule:=False
  On Error GoTo 0
End Sub

Ici, tu demandes à ce que OnTime revienne au bout d'une heure :

RunWhen = Now + TimeValue("01:00:00")
Application.OnTime RunWhen, "FermerWbk"

durant cette heure, Ontime décompte le temps mais tu n'y a pas accès donc, si tu veux avoir un décompte, tu n'as pas vraiment le choix que de raccourcir l'appel à OnTime afin de pouvoir montrer l'avancement.

Pour pouvoir ce que je veux dire, voici un classeur avec une ProgressBar. Cliques sur le bouton "Décompte" :

Okey tout s'éclair avec un exemple, franchement c'est super, j'avais entre temps bidouillé un truc franchement moche (mais qui fonctionnais ) En tout cas c'est exactement ce dont javais besoins, un grand merci

Cependant aurais tu une explication sur le fait que le progressebar "bug" à l'ouverture du classeur (comme sur l'image ci-dessous) ? Tout se remet en place une fois que je modifie la taille de la fenêtre du classeur (Plutôt pénible comme manip à la fin )

Bonjour,

Comme nous n'avons pas la même version d'Excel (2007 pour moi), le mieux serait que tu supprimes la barre de progression que j'ai mis et que tu en crée une nouvelle après, soit tu renommes la barre en "ProgressBar1" soit tu adaptes son nom dans le code

Et bien non cela ne change rien... Je vais chercher de mon coté une solution

Sinon,

une version avec deux Labels :

Très sympas cette alternative et ça marche nickel ! Pour ma part j'en ai finit avec ce poste, encore merci pour ton aide précieuse avec laquelle je progresse encore sur VBA

Bonne continuation

Finalement je revient chercher de l'aide, j'ai pu adapter ce que tu m'as donné à mon projet. Mais je me suis rendu compte que une fois le timer lancé et si j'appui à nouveau sur le bouton, le timer repart à zéro mais le décompte ne ce fait plus correctement ! Comment faire pour avoir un bouton qui reset correctement le timer ?

Ce que je ne comprend pas c'est quand j'ouvre mon classeur, j'appel Decompte et tout se passe bien, même si j'ai quitter Excel en ayant enregistrer avec le timer en cours d'execution alors que quand j'appel Decompte avec un bouton sur la feuille tout se dérègle ! Je met mon fichier en PJ (le mot de passe est 7894) avec ma liste au père noël dedans

Bonjour,

Pour pouvoir mettre en pause, il te faut utiliser une variable Booléenne publique (visible dans tout le projet par tous les objets) puis la mettre à Vrai à l'ouverture d'un formulaire et à Faux à sa fermeture avec relance du Timer. Code dans les formulaires (strictement identiques pour les trois) :

Private Sub UserForm_Activate()

    Pause = True

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

    RelancerTimer

End Sub

La procédure de relance appelée à la fermeture du formulaire ayant mis en pause :

Sub RelancerTimer()

    Pause = False
    Timer

End Sub

Et enfin, le Timer avec contrôle de la variable "Pause" :

Sub Timer()

    Sheets("MENU").Label1.Caption = "Il reste " & Format(Minute, "hh:mm:ss") & " avant la femeture auto"

    Progression Max - Minute, Max

    Minute = Minute - Intervalle

    If Pause = True Then Exit Sub '<--- contrôle pour une pause éventuelle

    If Minute < 0 Then

        ThisWorkbook.Save
        'Application.Quit
        Exit Sub

    End If

    Application.OnTime Now + TimeValue(Format(Intervalle, "hh:mm:ss")), "Timer"

End Sub

Concernant cette question :

Mais je me suis rendu compte que une fois le timer lancé et si j'appui à nouveau sur le bouton, le timer repart à zéro mais le décompte ne ce fait plus correctement ! Comment faire pour avoir un bouton qui reset correctement le timer ?

C'est normal qu'à chaque appuis sur le bouton (ou même en lançant directement depuis le VBE) le décompte repart à zéro puisque ça réinitialise les valeurs et on le voit bien dans le code que minute est remis à 15 (j'ai modifié pour plus de clarté) et le Label repositionné :

Sub Decompte()

    Heure = 1 / 24
    Minute = Heure / 60
    Seconde = Minute / 60

    Minute = Minute * 15

    Intervalle = Seconde

    With Sheets("MENU")

        .LblProgress.Width = 0
        .LblProgress.Top = .LblFond.Top
        .LblProgress.Left = .LblFond.Left
        .LblProgress.Height = .LblFond.Height
        .LblProgress.TextAlign = fmTextAlignCenter

    End With

    Max = Minute

    Timer

End Sub

Si tu mets un point d'arrêt sur la ligne de code : ThisWorkbook.Save et que tu cliques deux ou trois secondes avant terme, le compilateur n'atteindra pas cette ligne car "Minute" est réinitialisée et donc la condition : If Minute < 0 Then ne sera pas remplie !

Petite précision concernant le Timer, il te faut savoir que plus il y a d'instructions entre deux appels de OnTime, plus tu risques d'avoir de petits soubresauts au niveau de l'avancement du Label surtout en demandant un avancement par seconde !

Merci pour ta réponse et tes conseils. Ce que je crois comprendre de ton premier message :

Dans le module où se trouve la gestion du timer j'ai écrit :

Dim Pause as Boolean

mais cela me donne un message d'erreur (Variable non définie). J'en conclu que je n'ai pas compris ton message.

...il te faut utiliser une variable Booléenne publique (visible dans tout le projet par tous les objets)...

Donc pas Dim mais Public :

Public Pause As Boolean

Autant pour moi, la prochaine fois je lirais mieux ce qui est écrit Tout a l'air de fonctionner parfaitement bien !