Mettre en pause 1h ma macro après son exécution

Bonjour à tous,

J'ai la macro suivante qui me permet d'envoyer un mail avec un graphique joint dans le corps du mail.

Cependant ce mail est déclenché lorsque la valeur d'une cellule dépasse 0.5.

Je souhaite mettre une temporisation de 1h après l'envoi d'un mail.

Sub envoi_mail()
'Nécessite d'activer la référence "Microsoft Outlook Library"
Dim rng As Range
Dim Date_Sending As String
Dim OutApp As Object
Dim OutMail As Object
Dim adresses_mail As String
Dim mail_CC As String
Dim MyChart As Chart

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

'enregistrer le graph en image
Set MyChart = Worksheets("Grafico").ChartObjects(1).Chart
MyChart.Export Filename:=Environ("Temp") & "\graph1.jpg", FilterName:="JPG"

Set ColAttach = OutMail.Attachments
Set oAttach = ColAttach.Add(Environ("Temp") & "\graph1.jpg")

text1 = "<br /><br />" & "Bonjour," & "<br /><br />" & _
      Range("C14") & "<br /><br />" & Range("D38") & "<br /><br />" & _
      "Cordialement," & "<br /><br /><br />" & "L'équipe"

With OutMail
    .To = "mon mail"
    .Subject = "Test"
    .Subject = Date_Sending
    .HTMLBody = text1 & ", <br><br><IMG src=cid:graph1.jpg></BODY>"
    .Send
End With

Kill Environ("Temp") & "\graph1.jpg"
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

J'ai trouvé ce code

Application.Wait(Now + TimeValue("00:01:00"))

mais je vois pas comment l'appliquer.

En gros: IF ma macro Sub envoi_mail() vient d'etre execute ALORS attendre X SINON rien.

Merci

PS: Mon fichier fait désormais 7MB et comporte plusieurs macros, j'espère que mon explication est claire..

Bonjour Zouarv,

Ce n'est pas sur cette macro qu'il faut intervenir. Elle n'est que la conséquence de la macro qui déclenche après une hausse de valeur de 0.5 d'une cellule particulière ou d'un groupe de cellules.

C'est sur cette macro qui appelle envoi_mail qu'il faut interdire l'accès à Outlook.

Par exemple, lors de la hausse de valeur, il suffit de sauver l'horaire d'envoi sur une cellule, pourquoi pas sur A1 en feuille Grafico.

Puis de comparer lors d'une nouvelle hausse cette cellule A1 avec le nouveau horaire. Si l'écart est de moins d'1 heure alors pas d'appel à envoil_mail. A contrario donc si >1heure l'appel à la macro lançant le mail aura à nouveau lieu. Avec changement de la valeur A1 de Grafico.

X Cellus,

Merci du retour, j'avais pas cette vision là et c'est beaucoup plus simple finalement. Voici mon code pour lancer la macro du mail:

Private Sub Worksheet_Change_arancia(ByVal Target As Range)
    On Error Resume Next
    If Target.Cells.Count > 1 Then Exit Sub
  Set xRg = Intersect(Range("E1:E250"), Target.Value)
    If xRg Is Nothing Then Exit Sub
    If IsNumeric(Target.Value) And Target.Value > 0.9 & Target.Value < 1.1 Then
        Call envoi_mail_arancia
    End If
End Sub

Désormais j'ai crée mes deux variables pour faire ma comparaison:

Dim tim As Date
Dim VDate As Date

Spécifié ou les stocker la premiere fois:

tim = TimeValue(Worksheet("Grafico").Range("O3").Value)
VDate = DateValue(Worksheet("Grafico").Range("O4").Value)

Par contre comment réaliser la soustraction de deux variables temporelles et dire >59 min THEN X ?

Bonsoir Zouarv,

Pour vérifier la différence, il faut faire une soustraction. Dans le cas de variables temporelles cela est aussi vrai. Par exemple, fait dans un classeur vierge ce code:

Sub DiffTime()
[A1] = TimeValue("05:18:55PM")
[B1] = TimeValue("06:18:55PM")
[C1] = [B1] - [A1]
End Sub

Tu trouveras en [C1] une valeur qui est égale (arrondi à 5 chiffres après virgule) à 0,4167. Elle représente pour Excel un écart de temps d'une heure. Donc tout nombre inférieur à cette valeur est < à l'heure et au contraire tout nombre > à cette valeur est passé d'une heure.

Et si en B1 tu inscris 07:18:55PM tu auras comme écart 0,8333 soit 2 heures. Bien sûr pour le même jour. Mais tu as introduit une variable pour cela. On pouvait aussi contrôler à l'ouverture du classeur la date actuelle et la date indiquée dans la variable afin de faire un RAZ de la cellule test.

Voila comment tu peux maintenant au début de la macro WS_Change placer une condition menant à un exit sub ou pas.

Bonne continuation.

Bonjour X Cellus,

Merci pour ces indications, j'ai pas de facilité en prog en générale et il me manque toujours cette vision pour visualiser la construction. Merci de me donner des indications et non la réponse

Private Sub Worksheet_Change_rosso(ByVal Target As Range)

    On Error Resume Next
    If Target.Cells.Count > 1 Then Exit Sub
  Set xRg = Intersect(Range("E1:E250"), Target.Value)
    If xRg Is Nothing Then Exit Sub
    If IsNumeric(Target.Value) And Target.Value > 1.1 Then

    CurrentTime = Time()
    Sheets("Grafico").Range("O5").Value = CurrentTime
    If CurrentTime - TimeCompare > 0.4167 Or CurrentTime - TimeCompare = Null Then

        Call envoi_mail_rosso

    CurrentTime = Time()
    Sheets("Grafico").Range("O6").Value = CurrentTime
    Else
    End If

    End If

End Sub

Voici le code post modification. Un avis ?

Bonjour,

Un avis ?

Mon avis est que ce mail à toutes les chances de ne jamais partir !

A+

Galopin, par rapport à la formule du temps ?

    If CurrentTime - TimeCompare > 0.4167 Or CurrentTime - TimeCompare = Null Then

        Call envoi_mail_rosso

    CurrentTime = Time()
    Sheets("Grafico").Range("O6").Value = CurrentTime
    Else
    End If

Bonjour Zouarv,

Tu places en cellule O5 un temps suite à la modification à la hausse de 0.5 dans la zone concernée. Par contre qu'elle est la valeur de TimeCompare?

Place une ligne avec le code Stop juste avant Call afin d'arrêter le programme. Et ainsi vérifier les valeurs de tes variables en les survolant avec la souris. Ou voir celles-ci sur Grafico. N'oublie pas que ta comparaison se fait entre deux variables temporelles. Tu as choisi O5 et O6 pour contrôler la différence.

Par contre O5 est le temps ancien et O6 le temps actuel. Il est vrai qu'il n'est pas nécessaire de le conserver dans une cellule. C'est juste pour contrôler au début. La macro doit vérifier par rapport au temps ancien. Donc sur O5. Au départ cette cellule est vide et donc l'appel doit se faire.

Donc si cellule vide, la cellule obtient le temps en cours après la condition de comparaison. Dès qu'elle est renseignée la condition de comparaison contrôle son temps par rapport au temps actuel par différence. Si < à la pause choisie d'une heure alors Exit sub, donc pas d'appel à l'autre macro. Si > alors à nouveau O5 reçoit le temps actuel qui devient dès lors le temps ancien. Et ainsi de suite...

Relis aussi la condition sur la date. Le temps doit être comparé sur une date identique. Essaye encore.

À suivre...

Mettre la tête dans le sable ne supprime pas le danger !

On Error Resume Next

Mettre les problèmes sous le tapis, non plus...

A+

A nouveau,

Voici un court exemple sur fichier joint d'une temporisation de 5 minutes.

Sur la feuille tempo, la macro s'exécutera en augmentant la cellule C5 si le temps écoulé entre deux hausses est de + 5 mn. Sinon il faudra patienter.

Merci pour ce fichier, c'est plus clair. Je compile sans erreurs mais pas plus avancé dans le résultat final... Je reviens demain avec plus d'énergie. Merci @X Cellus !

Private Sub Worksheet_Change_rosso(ByVal Target As Range)

    On Error Resume Next

    Worksheets("Grafico").Range("O5").Value = TimeValue(Now()) 'ou à la place de now Worksheets("Grafico").Range("O4").Value

    If Target.Cells.Count > 1 Then Exit Sub
    Set xRg = Intersect(Range("E1:E250"), Target.Value) ' cette range est dans une autre feuille que "Grafico" qui est "Leakage Value"

    If xRg Is Nothing Then Exit Sub

    If Worksheets("Grafico").Range("O6").Value = "" Then

    If IsNumeric(Target.Value) And Target.Value > 1.1 & (Worksheets("Grafico").Range("O6").Value - Worksheets("Grafico").Range("O5").Value) > 0.4167 Then

        Call envoi_mail_rosso

    Else: Exit Sub

    Worksheets("Grafico").Range("O5").Value = Worksheets("Grafico").Range("O6").Value

    End If
    End If

End Sub

Compiler sans erreur est une chose, mettre les erreurs sous le tapis en est une autre !

Vire le

On error resume next

et exécute en mode pas à pas... Tu verras que tu ne vas pas plus loin que

Set xRg = Intersect(Range("E1:E250"), Target.Value)

Comme xRg est toujours Nothing tu vas toujours Exit Sub...

Je n'ai pas examiné le reste du code...

A+

A nouveau,

Worksheets("Grafico").Range("O6").Value = TimeValue(Now())

Attention tu oublies de lancer le call dans

If Worksheets("Grafico").Range("O5").Value = "" Then

IsNumeric(Target.Value) And Target.Value > 1.1

Le code serait

If Worksheets("Grafico").Range("O5").Value = "" and (IsNumeric(Target.Value) And Target.Value > 1.1) then  Call envoi_mail_rosso 

Dans cette première condition on vérifie que O5 est vide et que la hausse soit prise en compte. Ensuite O5 prendra le temps actuel. Donc il n'y as pas d'exit sub ici. Du fait qu'il n'y a pas de pause au départ.

Lors du prochain déclenchement de la macro cette 1ière condition ne sera plus vrai puisque O5 n'est plus vide. Et donc c'est la deuxième condition qui sera active. Ce sont deux conditions alternatives. Si l'une fonctionne l'autre pas.

    If IsNumeric(Target.Value) And Target.Value > 1.1 & (Worksheets("Grafico").Range("O6").Value - Worksheets("Grafico").Range("O5").Value) > 0.4167 Then Call... Else Exit sub

Il manque ici à vérifier que O5 ne soit pas vide, à rajouter donc. A ne pas oublier de vider O5 à l'ouverture du classeur. Pour commencer par la condition une. Il manquera ensuite à simplifier car trop de longue répétition (variables).

Par exemple faire Set ExTps = Worksheets("Grafico").Range("O5").Value . Idem pour O6 en ActTps...

Encore un petit effort.

A suivre...

Dim tim As Date
Dim xRg As Range

Sub Worksheet_Change_rosso(ByVal Target As Range)

    'Dans mon workbook.Open Worksheets("Grafico").Range("O5").Value = ""

    'On Error Resume Next

    Set TpsO5 = Worksheets("Grafico").Range("O5").Value
        TpsO6 = Worksheets("Grafico").Range("O6").Value

    TpsO6 = TimeValue(Now())

    Worksheets("Grafico").Range("O7").Value = TimeValue(Now())

    Set xRg = Intersect(Worksheets("Leakage value").Range("E1:E250"), Target.Value)

    If xRg Is Nothing Then Exit Sub

    If TpsO5 = "" And (IsNumeric(Target.Value) And Target.Value > 1.1) Then Call envoi_mail_rosso

    If IsNumeric(Target.Value) And TpsO5 <> "" And Target.Value > 1.1 And (TpsO6 - TpsO5 = Tps05) > 0.4167 Then

    Call envoi_mail_rosso

    Else: Exit Sub

    TpsO5 = TpsO6

    End If

End Sub

Mééééééééééééé...

J'avais même pas vu ça :

Tu as essayé de faire un débogage ?

Sub Worksheet_Change_rosso(ByVal Target As Range)

Ça sort d’où ça ? Dans quel module ? Et comment tu la lances cette macro ? C'est quoi Target ?

A mon avis c'est n'importe quoi : Tu n'as pas le droit de modifier le nom d'une macro évènementielle.

Sinon elle ne s'exécute jamais...

Pour conclure je te donne la solution (juste pour le début) après, pour le mail, je vous laisserai broder...

Sub Worksheet_Change(ByVal Target As Range)
Dim xRg As Range
    Set xRg = Intersect(Worksheets("Leakage value").Range("E1:E250"), Target) 'surtout pas de .Value !
    If xRg Is Nothing Then Exit Sub
'Maintenant tu as des chances d'aller plus loin dans ta macro :
MsgBox "Bravo !"
End Sub

A+

Le débogage était pas clair, maintenant c'est bon... Mou du bulbe ce matin...

J'ai mis les deux codes suivants dans mon module numéro 1 (je suppose que l'ordre des modules n'a pas d'impacts à mon échelle).

Le target était une variable dans mon code précédent mais trop complexe et inutile finalement.

A mon avis c'est n'importe quoi : Tu n'as pas le droit de modifier le nom d'une macro évènementielle.

Sinon elle ne s'exécute jamais..

Tu as grandement raison, je pouvais rien faire

Ma macro s'exécute toutes les 15 min pour le moment (J'ai une base de données qui charge sur une feuille et c'est assez long +-1min):

Sub Actualiser()

' Définit l'intervalle avec l'heure actuelle
    Uneheure = TimeSerial(Hour(Time), Minute(Time) + 15, Second(Time))
        ' Appel récursif
        Application.OnTime Uneheure, "Actualiser"
        Call Mamacro
        Call Worksheet_Change

End Sub

Je peux tout compiler et valider chaque étape (F8) désormais:

Sub Worksheet_Change()

Dim xRg As Range
Dim Tps05
Dim Tps06

    TpsO5 = Sheets("Grafico").Range("O5").Value
    TpsO6 = Sheets("Grafico").Range("O6").Value

    TpsO6 = TimeValue(Now())

    Sheets("Grafico").Range("O7") = Format(Now, "MM/DD/YYYY HH:MM")

    Set xRg = Sheets("Leakage value").Range("E1:E250")

    If xRg Is Nothing Then Exit Sub

    If TpsO5 = "" And xRg.Cells(1, 5).Value > 1.1 Then Call envoi_mail_rosso

    If IsNumeric(xRg.Cells(1, 5).Value) And TpsO5 <> "" And xRg.Cells(1, 5).Value > 1.1 And (TpsO6 - TpsO5 = Tps05) > 0.4167 Then

    Call envoi_mail_rosso

    Else: Exit Sub

    TpsO5 = TpsO6

    End If

End Sub

Ça sert à quoi que Galopin il se décarcasse ?

Puisque je te dis que tu n'as pas le droit de modifier le nom d'une macro évènementielle !

C'est :

Sub Worksheet_Change(ByVal Target As Range)

Ya pas à y retoucher. Un point c'est tout.

Ensuite tu dois tester le range d'application avec intersect de cette manière

Dim xRg As Range
    Set xRg = Intersect(Worksheets("Leakage value").Range("E1:E250"), Target) 'Sans .Value ici !
    If xRg Is Nothing Then Exit Sub

Sinon ta macro elle s'exécute n'importe quand...

Sinon comme tu as fait :

    Set xRg = Sheets("Leakage value").Range("E1:E250")
    If xRg Is Nothing Then Exit Sub

Dans ce cas pas la peine de tester nothing puisque xRg est = Sheets("Leakage value").Range("E1:E250")

Le tester aussitôt après relève d'un manque de confiance excessif !

A+

Galopin se décarcasse et Zouarv le remercie beaucoup

Cependant je peux plus exécuter mon pas à pas désormais...Je comprends pas.

Sub Worksheet_Change(ByVal Target As Range)

Dim xRg As Range
Dim Tps05 As Date
Dim Tps06 As Date
    TpsO5 = Sheets("Grafico").Range("O5").Value
    TpsO6 = Sheets("Grafico").Range("O6").Value

    TpsO6 = TimeValue(Now())

    Sheets("Grafico").Range("O7") = TimeValue(Now())

    Set xRg = Intersect(Worksheets("Leakage value").Range("E1:E250"), Target) 'Sans .Value ici !

    If xRg Is Nothing Then Exit Sub

    If TpsO5 = "" And xRg.Cells(1, 5).Value > 1.1 Then Call envoi_mail_rosso

    TpsO5 = TpsO6

    If IsNumeric(xRg.Cells(1, 5).Value) And TpsO5 <> "" And xRg.Cells(1, 5).Value > 1.1 And (TpsO6 - TpsO5 = Tps05) > 0.4167 Then

    Call envoi_mail_rosso

    Else: Exit Sub

    End If

End Sub

Bonsoir Zouarv,

Heureusement que Galopin01 te surveille car tu empiétais sur le boulot des programmeurs d'Excel en touchant aux procédures événementielles en les "rebaptisant". Celles-ci sont dans le domaine réservé du logiciel. Il faut respecter cela.

Tu peux créer des fonctions en leur donnant un nom particulier mais cela est différent. Mis à part cette erreur tu as avancé. J'ai vu l'introduction d'une date en O7 qui permettra de pouvoir vérifier un changement de jour pour vider O5. Mais il faudra prévoir de la sauvegarder car O7 est basé sur maintenant (date Jour).

Par contre (TpsO6 - TpsO5 = Tps05) > 0.4167 … C'est quoi cette formule avec Tps05 (zéroCinq).

Ma formule c'est TpsO6-TpsO5 > 0.4167 . Pourquoi ce changement.

Tu ne peux pas démarrer un débogage immédiatement car le propre de ce genre de macro c'est de démarrer uniquement si tu changes quelque chose dans Target donc :

Pour lancer la procédure en mode débogage, il faut poser un point d'arret sur ton code :

Tu vas cliquer sur la bordure blanche à gauche de la ligne indiquée :

La ligne doit se mettre en surbrillance et un gros point rouge s'afficher. Le point d'arret est posé.

Tu retournes dans excel, tu changes une valeur (ou tu rentres un espace invisible dans un texte) dans le Range("E1:E250) et tu valides.

tu verras qu’aussitôt VBA s'affiche à la ligne surlignée. Ensuite TAPUKA faire [F8] [F8] [F8] pour parcourir toutes les lignes.

En survolant les différentes variables avec le curseur de la souris tu verras s'afficher les différentes valeurs qu'elles prennent et tu verras alors que xRg n'est pas nothing... puisque le code continue !

A+