XL 2019 Aide pour finaliser macro qui arrête une macro en boucle

[phil77515]

bonjour a tous

j'aurais besoin d'un petit coup de code pour écrire une macro qui en arrête une autre

j'ai créer une macro qui émet un beep toutes les 3 secondes .

j'ai trouvé une code pour y mettre fin mais ca n'est pas propre

quelqu'un aurait t'il la gentillesse de m'aider

merci par avance

phil

 

[Dudu2]

Bonjour,
Ça peut-être ?

Option Explicit

Declare Function Beep Lib "kernel32" (ByVal Frequence As Long, ByVal Duree As Long) As Long

Private BeepBeepLeCoyote As Boolean

Sub Beep_open()
    BeepBeepLeCoyote = True
    Call BeepBeep
End Sub

Sub BeepBeep()
    If BeepBeepLeCoyote Then
        Call Beep(1500, 880)
        Application.OnTime Now + TimeValue("00:00:03"), "BeepBeep"
    End If
End Sub


Sub Beep_close()
    If MsgBox("On arrête ?", vbYesNo) = vbYes Then BeepBeepLeCoyote = False
End Sub

 

[phil77515]

bonjour DUDU2

c'est impeccable, c'est tout a fait ce que je recherchais

il n'y avait pas moyen d'y arriver avec ce que j'avais fait ?

merci à toi

 

[Dudu2]

il n'y avait pas moyen d'y arriver avec ce que j'avais fait ?

Oui, il y a un autre moyen qui est d'annuler le Application.OnTime.
Pour ça il faut mémoriser le "time" du OnTime et sur le Application.OnTime citer le time et la fonction avec l'option Schedule:=False

Option Explicit

Declare Function Beep Lib "kernel32" (ByVal Frequence As Long, ByVal Duree As Long) As Long

Private RunTime As Variant

Sub Beep_open()
    Call Beep(1500, 880)
    RunTime = Now + TimeValue("00:00:03")
    Application.OnTime EarliestTime:=RunTime, Procedure:="Beep_open", Schedule:=True
End Sub

Sub Beep_close()
    If MsgBox("On arrête ?", vbYesNo) = vbYes Then
        If RunTime <> 0 Then Application.OnTime EarliestTime:=RunTime, Procedure:="Beep_open", Schedule:=False
        RunTime = 0
    End If
End Sub

 

[phil77515]

merci dudu2 , j'ai encore besoin d'un peit coup de main
je veux intégrer plusieurs infos dans la boite de message , tout va bien , tant que je n'affiche pas l'heure

' celui ci fonctionne

' If MsgBox("message 1" & vbCrLf & vbCrLf & _
'"On arrête le Beep ?", vbQuestion + vbYesNo, "Titre de la boite de message") = vbYes Then BeepBeepLeCoyote = False


'et la c'est le souk

If MsgBox("message 1" & vbCrLf & vbCrLf & _
Chr(10) & "Il est " & Format(Now(), "hh") & " H et " & Format(Now(), "mm") & " mn.") & _
"On arrête le Beep ?", vbQuestion + vbYesNo, "Titre de la boite de message") = vbYes Then BeepBeepLeCoyote = False

merci

 

[Dudu2]

If MsgBox("message 1" & vbCrLf & vbCrLf & _
          "Il est " & Format(Now, "hh\h et mm\m\n") & vbCrLf & vbCrLf & _
          "On arrête le Beep ?", vbQuestion + vbYesNo, "Titre de la boite de message") = vbYes Then BeepBeepLeCoyote = False

 

[phil77515]

merci , ca sert a rien de pomper des codes sur d'autres exemples LOL

encore merci

 

[phil77515]

pourtant la formule fonctionnait tant qu on ne mettait pas un If

MsgBox ("message 1" & vbCrLf & vbCrLf & Chr(10) & "Il est " & Format(Now(), "hh") & " H et " & Format(Now(), "mm") & " mn.") & Chr(10) + "On arrête le Beep ?", vbQuestion + vbYesNo, "Titre de la boite de message"

 

[Dudu2]

Oui mais quand tu as mis un <If> la syntaxe n'était pas correcte:

If MsgBox("message 1" & vbCrLf & vbCrLf & _
Chr(10) & "Il est " & Format(Now(), "hh") & " H et " & Format(Now(), "mm") & " mn.") & _
"On arrête le Beep ?", vbQuestion + vbYesNo, "Titre de la boite de message") = vbYes Then BeepBeepLeCoyote = False

Il n'y a pas de ')' après le "mn.".

 

[phil77515]

en tout ca merci , tres sympa de ta part
bon week end