Discussion :

[Mugette]

Bonjour,

Je cherche a faire un compte a rebours dynamique de 108 minutes, est-ce possible sans controle Timer dans la forme.

Je voudrais que l'utilisateur puisse voir les secondes qui défile...
Aidez moi j'ai essayé avec la fonction Timer, TimeSerial mais je dois mal les utiliser parce que ca marche pas tres bien.
Aidez-moi svp!!

[ar_men]

sans timer ??
voudrais-tu péciser

[loacast]

sur cathy astuce :

Créer un timer
Dans un module, tapez le code suivant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Dim Lheure As Double
Dim Interval As Integer
 
Public Sub LancerTimer(NbS As Integer)
      'L'application ExecutionTimer se lancera toutes les 0 heure, 0 minute et Interval seconde
      Interval = NbS
      ' la ligne suivante va lancer la procédure ExecutionTimer tous les intervalles secondes
      Application.OnTime Now + TimeSerial(0, 0, Interval), "ExecutionTimer"
End Sub
 
Public Sub ArretTimer()
      'Pour arrêter le timer, il suffit d'appeler cette procédure.
On Error Resume Next
      Application.OnTime Lheure, "ExecutionTimer", , False
End Sub
 
Public Sub ExecutionTimer()
      'code à exécuter à la fin de chaque Interval secondes
            'mettez ici votre code
      'code obligatoire 
      Lheure = Now + TimeSerial(0, 0, Interval)
      Application.OnTime Lheure, "ExecutionTimer"
End Sub

[Mugette]

je voudrais faire un compte a rebours de 108 min.
mais comme je le fais sous excel/vb je n'ai pas le controle Timer1_Timer.
je voudrais le faire soit avec la fonction Time Serial ou alors avec la fonction Timer.

[méphistopheles]

oui, mais tu dois utiliser une boucle.

je te conseille le timer néamoins, avec un interval à 1:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
dim IniT as string
private sub form_load()
timer1.enabled=false
end sub
private sub cmddecomte_click()
iniT=replace(replace(time,left(time,2),left(time,2)+1),mid(time,4,2),mid(time,4,2)+54)
timer1.interval=1
timer1.enabled=true
end sub
private sub timer1_timer()
text1.text=datediff("n",time,init) 
if text1.text=0 then 
    msgbox "fini"
    timer1.enabled=false
end if
end sub

voilà, ça devrais allaer,précision de l'horloge windows.


salut

[méphistopheles]

ha, et si tu veux le mettre en version boucle:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
dim IniT as string 
private sub cmddecomte_click() 
iniT=replace(replace(time,left(time,2),left(time,2)+1),mid(time,4,2),mid(time,4,2)+54) 
do while datediff("n",time,init) 
  text1.text=datediff("n",time,init) 
  if text1.text=0 then 
      msgbox "fini" 
      timer1.enabled=false 
  end if  
  doevents
loop
end sub

salut

[ar_men]

"timer" donne le nombre de secondes depuis minuit
attention donc à une procédure lancée à minuit - 108 mn ...

bon (en code générique)

a = timer
b = 108 * 60
d = 0

do while c < a + b
c = timer
si ton traitement est ok
d = 1
exit do
loop

if d = 0 alors ....

et puis 108 peut etre une variable, c encore plus générique ...............

[leroissejp]

Bonsoir,

méphistopheles, il n'y a pas de contrôle Timer sur VBA Excel, et la fonction Replace, il faut la créer.

jpleroisse

[méphistopheles]

y'a rien qui remplace le replace?

enfin, c'est vrai que je suis plutot vb6.

salut

[AlainTech]

Replace existe à partir de VBA Office 2000.

Pour le timer, je ne suis pas certain mais j'ai vu quelque part un timer utilisable sous VBA.

Si je retrouve l'info, je reviens la mettre ici.

[leroissejp]

Bonsoir,
Sous VBA Office 97, il faut créer une fonction Replace.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
 
 Public Function Replace( _
         ByVal expression As String, _
         ByVal find As String, _
        ByVal replacewith As String, _
        Optional ByVal start As Long = 1, _
        Optional ByVal count As Long = -1, _
         Optional ByVal compare As Long)
 
   Dim lenFind As Long
   Dim lenNext As Long
   Dim lenReplace As Long
   Dim lenExpression As Long
 
   'Emulation de Const vbUseCompareOption = -1
   If IsEmpty(compare) Or _
     ((compare <> vbBinaryCompare) And (compare <> vbTextCompare)) Then
     compare = IIf("A" = "a", vbTextCompare, vbBinaryCompare)
End If
 
If start > Len(expression) Then
     Replace = vbNullString
Else
     If Not ((start < 1) Or _
     (start > Len(expression)) Or (find = vbNullString)) Then
    lenFind = Len(find)
     lenReplace = Len(replacewith)
     start = InStr(start, expression, find, compare)
     Do While (start <> 0) And (count <> 0)
      lenExpression = Len(expression)
      lenNext = start + lenFind
       expression = Mid$(expression, 1, start - 1) & replacewith & _
         IIf(lenNext <= lenExpression, _
         Mid$(expression, lenNext), vbNullString)
       count = count - 1
      start = InStr(start + lenReplace, expression, find, compare)
       Loop
End If
     Replace = expression
End If
 
End Function

Utilisation

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
Private Sub CommandButton1_Click()
Dim str1 As String
str1 = "Ca va mal"
MsgBox Replace(str1, "mal", "bien")
End Sub

jpleroisse

[Mugette]

mephistopheles, il n'y a qu'un seul truc que je comprend pas et qui gene le code sous Vbexcel, c'est :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
private sub form_load()
timer1.enabled=false
end sub

form_load n'existe pas donc timer1.Enable non plus...

Peut tu m'eclairer stp ??

Sinon merci a tous je vais essayer de faire quelque chose.

ciao

[SfJ5Rpw8]

à priori Timer1 est un contrôle VB6 ... placé sur la FORM et pour le load tu as

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

UserForm_Initialize()

[SfJ5Rpw8]

salut, Muguette .. je n'avais pas mis de code avant car je pensai que tu aurai pu adapter le code à Loacast ....

voici le code à mettre dans un module VBA

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Dim mDate As Date ' Memo date de fin compte à rebour
Sub LanceCompteur()
    mDate = Now + TimeSerial(0, 0, 10)
 
    MajCompteur
End Sub
 
Sub MajCompteur() ' Procedure mise à jout compteur
  Dim dRestant As Date
  If mDate > 0 Then
     dRestant = mDate - Now
     If dRestant > 0 Then
       Application.OnTime Now + TimeValue("00:00:01"), "MajCompteur" ' Auto-Rappel dans 1s pour Mise à jour
     Else
       MsgBox "Fin Compte à rebours"
       mDate = 0
     End If
     UserForm3.Label1 = Format(dRestant, "hh:mm:ss")
 
    End If
End Sub

Puis dans l'userform... ( moi c'est Useform3..)
une userForm avec un bouton de lancement CommandButton1 et le label1 pour l'affichage...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Private Sub CommandButton1_Click()
 LanceCompteur
End Sub

[ouskel'n'or]

Hello Bbil,

Tu as un jour proposé un timer en VBA, simulant le lancement d'une macro "sous interruption".
Je n'ai pas tout suivi mais ne crois-tu pas que ta solution est ce que cherche Mugette ?
J'ai extrapolé :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Public Chrono As Boolean
Sub TimerLancerMacroToutesLesSecondes()
Dim ok As Boolean, HFin, msg
    HFin = Now + TimeValue("00:00:10")  'Délai fixé à 10 secondes
    Chrono = True
    JeFaisTourner
    Do    'Simule ton code
        msg = "Continuer ? " & Int((HFin - Now) * 100000)
        ok = MsgBox(msg, vbYesNo, "POURSUIVRE LE DÉCOMPTE") = 6 
             ' MsgBox Interrompt la procédure mais pas JeFaisTourner
        ok = ok And Now < HFin
    Loop While ok  'Arrête dans tous les cas la procédure si temps est dépassé 
    Chrono = False
End Sub
 
 
Sub JeFaisTourner()
    'Relance la pendule (mise à jour de OnTime) toutes les secondes
    If Chrono Then Application.OnTime Now + TimeValue("00:00:01"), "JeFaisTourner"
End Sub

A+

[SfJ5Rpw8]

Hello Bbil,
Tu as un jour proposé un timer en VBA,....

eu ... c'est ce que j'ai mis dans mon post précédent...

[ouskel'n'or]

eu ... c'est ce que j'ai mis dans mon post précédent...

j'ai été interrompu en plein effort, c'est pourquoi ma réponse, commencée 50 minutes plus tôt, est partie... 50 mn + tard...

Ben voila, seulement maintenant, j'ai eu le temps d'épurer ma réponse...

A+

[leroissejp]

Bonjour,
Ce code est fait pour 10 secondes, pour 108 minutes tu mets 6480.
Mais attention, pendant ce temps , tu n'as plus la possibilé de faire autre chose que d'attendre.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
 
Private Sub CommandButton2_Click()
Dim i As Integer
Application.ScreenUpdating = False
For i = 10 To 0 Step -1
     Application.Wait Now + TimeValue("00:00:01")
    Label1 = i
Next i
Application.ScreenUpdating = True
End Sub

jpleroisse

[SfJ5Rpw8]

tiens ... leroissejp ... tu m fais penser à un truc ..dans mon code ... pour les 108 minutes , remplacer dans la fonction lancement compteur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

  mDate = Now + TimeSerial(0, 0, 10)

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

  mDate = Now + TimeSerial(0, 108,0)

[leroissejp]

Bonjour,
bbil, j'avais déjà essayé ton code, mais celà ne fonctionnait pas, c'est pour celà que j'ai posté. Je viens de m'apercevoir que j'avais fais une erreur lors de la copie, maintenant celà fonctionne (je l'ai vite placé en réserve dans un fichier texte).

jpleroisse