Help chrono :(

ted_etbill

XLDnaute Nouveau
Bonjour à tous;

je vous soumet un probleme qui a gaché ma journée......:mad::mad:

J'ai une macro qui dure environ 2 min.

Lors de l'execution de la macro, le code s'arrete a plusieurs reprises pour proposer des options a l'utilisateur.

Je souhaite utiliser un code que j'ai récupéré qui permet de faire un chrono avec une fonction pause (compte le temps d'execution de tous les modules, mais sans tenir compte du temps d'attente des réponses de l'utilisateur).

Voici le code que je souhaite utiliser pour le chrono:

Public CHRONO, Départ, tp, T As Integer
Public oVal_Chrono As Long
Public Total_Chrono As String

Sub oStart()
If T = 1 Then
Départ = Timer() - tp
Else
Départ = Timer()
End If
majChrono
End Sub

Sub oPause()
T = 1
On Error Resume Next
Application.OnTime CHRONO, Procedure:="majChrono", Schedule:=False
tp = oVal_Chrono
End Sub

Sub oStop()
On Error Resume Next
Application.OnTime CHRONO, Procedure:="majChrono", Schedule:=False
T = 0
End Sub

Sub majChrono()
oVal_Chrono = (Timer() - Départ)
CHRONO = Now + TimeValue("00:00:1")
Application.OnTime CHRONO, "majChrono", Schedule:=True
Total_Chrono = Durée(oVal_Chrono) '(Durée est une fonction que j'ai faite pour convertir un LONG en H/M/S
End Sub



lorsque j'appelle les procédure oStart, oPause et oStop, ca fonctionne a merveille.

Le soucis c'est que ca ne fonctionne plus dans ma procédure principale......
voici ce que je souhaite faire dans un extrait de mon code :


Public Sub MAIN()
'Stoppe le rafraichissement de l'écran:
Application.ScreenUpdating = False

'Init des flags d'avertissement des modules appelés:
AVERT_STATUT = False

'Lancement du chrono:
oStart

'On vérifie que la feuille rawdata est présente:
On Error GoTo ERREUR1
If ActiveWorkbook.Worksheets("rawdata") Is Nothing Then GoTo ERREUR1
On Error GoTo 0

'Etape 1:
Call TEXTE
'Test si erreur lors du regroupement:
If ERR_COL = True Then GoTo ERREUR2
If ERR_NO_DONNEES = True Then GoTo ERREUR3
If ERR_LIGNE = True Then GoTo ERREUR4
If ERR_COMM = True Then GoTo ERREUR5


'Etape 2:
Call FILTRE
'Test si erreur lors du tri:
If ERR_DATE = True Then GoTo ERREUR6
If ERR_HEURE = True Then GoTo ERREUR7

'Etape 3:
Call MEF
'Test si erreur lors de la mise en forme:
If AVERT_STATUT = True Then CreateObject("Wscript.shell").Popup "Certaines données n'ont pu être déterminés", 3, "AVERTISSEMENT", vbExclamation


'Etape 4: on met en page si impression demandée:
Print_Result = "sans impression"
'Pause du chrono:
oPause

If MsgBox("Voulez-vous imprimer ?", vbYesNo + vbQuestion, "MESSAGE") = vbYes Then
'Redemarrage du chrono
oStart
UserForm1.Caption = "RO:Etape 4/5 Mise en page ..."
Call MEP
Print_Result = "avec impression"
CreateObject("Wscript.shell").Popup "Impression lancée...", 3, "INFORMATION", vbInformation
End If



'Etape 5: on sauvegarde si souhaité
Save_Result = "sans sauvegarde"
'Pause du chrono:
oPause

If MsgBox("Voulez-vous sauvegarder ?", vbYesNo + vbQuestion, "MESSAGE") = vbYes Then
'Redemarrage du chrono
oStart
UserForm1.Caption = "RO:Etape 5/5 Sauvegarde ..."
Call SAVE
Save_Result = "avec sauvegarde dans fichier:"
Else
INFO_SAVE = ""
End If


'Arret du chrono:
oStop
......







A la fin du code je récupère le temps total de traitement par la variable Total_Chrono (sans les attentes aux messages)... et a chaque fois j'ai rien...


:confused::confused::confused::confused::confused:
 
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : Help chrono :(

Bonjour ted_etbill,

J'ai toujours trouvé l'instruction Application.OnTime difficile à manipuler. Voici un essai sans cette instruction.

Une fonction Chrono(X) (utilisée soit comme une Sub soit comme une function):
  • Chrono Raz -> remet le compteur à zéro et le met en route
  • Chrono Pause -> suspend le compteur
  • Chrono Redemarre -> remet le compteur en route
  • Chrono Fin -> arrête et bloque le compteur '. La prochaine instruction qui a un effet sera Chrono Raz

ou bien (par exemple):
MsgBox Chrono(Fin) arrête et bloque le compteur s'il n'est pas déjà bloqué puis affiche la durée.

Le code:
VB:
Option Explicit
 Const Raz = "raz", Pause = "pause", Redemarre = "redemarre", Fin = "fin"

Function Chrono(Todo) As Double
Static Duree As Double, Td As Double, Fini As Boolean
 Select Case Todo
  Case Raz
   Fini = False
   Duree = 0#
   Td = Timer()
  Case Pause
   If Not Fini Then Duree = Duree + Timer() - Td
  Case Redemarre
   If Not Fini Then Td = Timer()
  Case Fin
   If Not Fini Then Duree = Duree + Timer() - Td
   Fini = True
 End Select
 Chrono = Duree
End Function

Sub test()
Dim i

 Chrono Raz
 For i = 1 To 3
  DoEvents
  Chrono Pause
  MsgBox "Le temps n'est plus décompté, Continuer..."
  Chrono Redemarre
 Next i
 
 Chrono Pause
 If MsgBox("Traitement Long ?", vbYesNo + vbQuestion) = vbYes Then
  Chrono Redemarre
  TraitementLong
 Else
  Chrono Redemarre
  TraitementCourt
 End If
 
 ' fin du traitement TEST - on arrête le chrono avant un nouveau: Chrono Raz
 ' et on affiche la durée
 MsgBox "Durée hors boite dialogue  = " & Chrono(Fin)
 
End Sub

Sub TraitementLong()
Dim i
 For i = 1 To 50000:  DoEvents: Next i
End Sub

Sub TraitementCourt()
Dim i
 For i = 1 To 25000:  DoEvents: Next i
End Sub
 

Pièces jointes

  • Help chrono v1.xls
    36.5 KB · Affichages: 74
Dernière édition:

ted_etbill

XLDnaute Nouveau
Re : Help chrono :(

Bonjour MaPomme.


J'avais trouvé ceci en attendant:


Public Départ, tp, T As Integer
Public oVal_Chrono As String

Sub oStart()
'Si pause a été déclenchée:
If T = 1 Then
Départ = Now - tp
'sinon:
Else
Départ = Now
'init temps de pause
tp = 0
End If
End Sub

Sub oPause()
'Init flag de pause
T = 1
'Début de pause
tp = Now
End Sub

Sub oStop()
'si pause a été déclenchée:
If T = 1 Then oVal_Chrono = Durée(DateDiff("s", CDate(tp - Départ), CDate(Now - Départ))) 'Durée() =>fonction de conversion de secondes en Heures,minutes,secondes
'sinon
If T = 0 Then oVal_Chrono = Durée(DateDiff("s", CDate(Départ), CDate(Now)))
'RAZ chrono:
T = 0
Départ = 0
tp = 0
End Sub



Le soucis c'est que ca ne fonctionnait qu'avec 1 seule pause.....

Ta solution est excellente, et fonctionne sans soucis dans mon code !

Merci mille fois pour ton aide précieuse !!

(juste une question, pourquoi est-ce que le passage de la variable Todo ne fonctionne plus lorsque je place ton code dans un module différent de celui de mon code principal ? :confused:)


Merci
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : Help chrono :(

Bonjour ted_etbill,

(juste une question, pourquoi est-ce que le passage de la variable Todo ne fonctionne plus lorsque je place ton code dans un module différent de celui de mon code principal ? )

Dans le module où se trouve la procédure Chrono, faire précéder la déclaration des constantes par le mot clef Public.
Code:
Public Const Raz = "raz", Pause = "pause", Redemarre = "redemarre", Fin = "fin"

Cela aide-t-il ?
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : Help chrono :(

Bonsoir ted_etbill,

Une variante avec un module de classe réutilisable. On peut utiliser ainsi un chronomètre à partir de module, module de feuille excel ou encore de userform. On bénéficie aussi de la saisie semi-automatique. Voir exemples avec utilisation de deux instances simultanées ou dans un UserForm.

Le code de la classe "ClassChrono":
VB:
Option Explicit
Private xDuree As Double, Td As Double, Fini As Boolean

Public Sub RazEtDemarre()
   Fini = False
   xDuree = 0#
   Td = Timer()
End Sub

Public Sub DebutPause()
   If Not Fini Then xDuree = Duree + Timer() - Td
End Sub

Public Sub FinPause()
   If Not Fini Then Td = Timer()
End Sub

Public Sub Arrete()
   If Not Fini Then xDuree = xDuree + Timer() - Td
   Fini = True
End Sub

Property Get Duree() As Double
 Duree = xDuree
End Property

Property Get DureeTexte() As String
DureeTexte = Format(CDbl(Int(xDuree) / 86400#), "h"" h ""m"" min ""s"" s """) & _
  Format(Int(100 * (xDuree - Int(xDuree))), """et ""#0"" centième(s)""")
End Property

Le code de test (module de code de Feuil1):
VB:
Sub TEST()
Dim i As Long
' déclaration et création d'un chronomètre
Dim MonChrono1 As New ClassChrono
Dim MonChrono2 As New ClassChrono

 ' Lance les chronos 1 et 2 après RAZ
 MonChrono1.RazEtDemarre
 MonChrono2.RazEtDemarre
 
 For i = 1 To 3
  DoEvents
  ' met le chrono 1 en pause
  MonChrono1.DebutPause
  MsgBox "Le temps n'est plus décompté, Continuer..."
  ' fin de la pause, le chrono 1 est remis en route
  MonChrono1.FinPause
 Next i
 
 ' met le chrono 1 en pause
 MonChrono1.DebutPause
 If MsgBox("Le temps n'est plus décompté" & vbLf & _
  "Traitement Long ?", vbYesNo + vbQuestion) = vbYes Then
  ' fin de la pause du chrono 1
  MonChrono1.FinPause
  For i = 1 To 50000:  DoEvents: Next i
 Else
  ' fin de la pause du chrono 1
  MonChrono1.FinPause
  For i = 1 To 25000:  DoEvents: Next i
 End If
 
 ' fin des deux chronos
 MonChrono1.Arrete: MonChrono2.Arrete
 ' on affiche les durées
 MsgBox "durée totale : " & vbLf & MonChrono2.DureeTexte & vbLf & vbLf & _
  "dont durée hors boite dialogue : " & vbLf & MonChrono1.DureeTexte
End Sub

Le code de UserForm1:
VB:
Option Explicit
Dim Decompte As New ClassChrono

Private Sub UserForm_Initialize()
 Decompte.RazEtDemarre
End Sub

Private Sub UserForm_Terminate()
 Decompte.Arrete
 MsgBox "Durée existence de la feuille:" & vbLf & Decompte.DureeTexte
End Sub
 

Pièces jointes

  • Chrono Class v2.xls
    55 KB · Affichages: 74
Dernière édition:

ted_etbill

XLDnaute Nouveau
Re : Help chrono :(

J'ai jamais utiliser les modules de classe. (parce qu'honnetement j'ai un peu de mal a comprendre le parametrage :rolleyes:
j'utilise plutot des fonctions. Quel est l'avantage des modules de classe ? puisque les fonctions peuvent aussi être appelées depuis plusieurs modules.
 
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : Help chrono :(

J'ai jamais utiliser les modules de classe. (parce qu'honnetement j'ai un peu de mal a comprendre le parametrage :rolleyes:
j'utilise plutot des fonctions. Quel est l'avantage des modules de classe ? puisque les fonctions peuvent aussi être appelées depuis plusieurs modules.

D'autres plus férus que moi sur le domaine te répondraient avec bien plus de pertinence. Dans ce cas (c'est ta question du post #3) qui m'a fait penser à l'utilisation d'une classe.

Une classe "MaClasse", grosso-modo, peut-être considérée comme un type objet. Ce type objet embarque des propriétés et des méthodes pouvant être utilisées dès lors qu'on a défini une variable X et indiqué à VBA que cette variable est du type classe "MaClasse".

Pour déclarer une variable X de type "MaClasse", on peut utiliser l'instruction:
Code:
Dim Decompte As New MaClasse

Ensuite, on peut utiliser les propriétés et méthodes de MaClasse sur la variable (ou objet) X (ou l'instance X de MaClasse) avec une notation de type objet.
Propriété ==> X.propriété1 =123 ou msgbox X.propriété1
Méthode ==> X.methode1 param1, param2.

Dans notre cas, il fallait définir les constantes comme Public pour que le programme fonctionne. Avec la classe, il n'y a plus besoin de déclarer les constantes. Les noms sont définis dans la classe et sont accessibles dès qu'on a instancié une variable de type ClassChrono.

Un autre avantage est que dans un même module, on peut utiliser plusieurs variables de type chrono sans dupliquer du code. Il suffit d'instancier deux variables objet de type ClassChrono.

Un avantage supplémentaire est présent quand on écrit du code. Une fois la variable X défini comme étant du type MaClasse, l'éditeur de code va proposer la liste de choix des propriétes et méthodes de l'objet dès qu'on a saisi le nom de la variable suivi du point.

Il est normalement indispensable quand on fourni une classe de bien fournir aussi les descriptions précises des propriétés et méthodes. Mais bien souvent le programmeur et la documentation ne font pas bon ménage.

Il y aurait beaucoup d'autres choses à dire, je laisse à d'autres, plus compétents, le soin de compléter.
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 326
Messages
2 087 311
Membres
103 513
dernier inscrit
adel.01.01.80.19