Problème de Boucle (n'arrete pas)

  • Initiateur de la discussion Initiateur de la discussion bloomby
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

bloomby

XLDnaute Occasionnel
Bonjour à tous,

Alors, voila j'ai une boucle qui ne fonctionne pas de la bonne façon pour le moment;

Par exemple, lorsque la valeur de la cellule A5 change
la macro ouvre une MsgBox et envoie un email,

Par contre, je suis incapable de fermer la msgbox ainsi que la fenêtre outlook
c'est comme si la boucle continuait alors qu'elle ne devrait pas

HTML:
Private Sub Worksheet_Calculate()
Dim i, j As Integer
Dim ol As Object
Dim olmail As Object
Dim CurrFile As Object
Dim Msg, Style, Title, Response
Set ol = CreateObject("Outlook.Application")
Set olmail = ol.CreateItem(0)
j = 1
For i = 1 To 254 Step 11
    If Cells(5, i) <> M(j) Then '1
        M(j) = Cells(5, i)

    With olmail
        .To = "timeislimite@hotmail.com"
        .Subject = Cells(5, i)
        .Body = ": " & Cells(7, i) & "  : " & Cells(7, i + 1)
       ' .Attachments.Add "c:\data\essai.doc"
         '.Send
         .display
    'Debug.Print PlaySoundFileA("C:\Windows\Media\tada.wav")
    
    Call Sounds
    Msg = ": " & Cells(7, i) & "  : " & Cells(7, i + 1)
    Style = vbYesNoCancel + vbQuestion + vbDefaultButton1
    Title = Cells(5, i)
    Response = MsgBox(Msg, Style, Title)
    End With
    End If
j = j + 1
Next
End Sub

merci
 

Pièces jointes

Re : Problème de Boucle (n'arrete pas)

Bonsoir Bloomby, bonsoir à tous,

Je ne suis pas sûr d'avoir bien compris ce que tu veux faire, cependant la macro va exécuter 23 fois le lancement de Outlook avec le message puisque la condition:

Code:
If Cells(5, i) <> M(j) Then

est toujours vrai étant donné que la table M n'est pas initialisée donc ne contient que des chaînes vides et comme tu fais J=J+1 en fin de boucle, tu compares toujours la valeur de A5 à une chaîne vide.

@+

Gael
 
Re : Problème de Boucle (n'arrete pas)

Je voulais créer une boucle qui me permettrait d'optimiser mon code,
et ne pas écrire 50 fois pratiquement la même chose comme suit:

Private Sub Worksheet_Calculate()
Code:
    If [A5] <> M1 Then
        M1 = [A5]
        SendMail1
    End If
    
    If [L5] <> M2 Then
        M2 = [L5]
        SendMail2
    End If
    
    If [W5] <> M3 Then
        M3 = [W5]
        SendMail3
    End If

    If [AH5] <> M4 Then
        M4 = [AH5]
        SendMail4
    End If
    
    If [AS5] <> M5 Then
        M5 = [AS5]
        SendMail5
    End If
End Sub[/QUOTE]

[QUOTE]Sub SendMail1()

Dim ol As Object
Dim olmail As Object
Dim CurrFile As Object
Set ol = CreateObject("Outlook.Application")
Set olmail = ol.CreateItem(0)

With olmail
    .To = "timeislimite@hotmail.com"
    .Subject = [A5]
    .Body = ": " & [A7] & "  : " & [B7]
   ' .Attachments.Add "c:\data\essai.doc"
     .Send
'Debug.Print PlaySoundFileA("C:\Windows\Media\tada.wav")
Dim Msg, Style, Title, Response
Call Sounds
Msg = ": " & [A7] & "  : " & [B7]
Style = vbYesNoCancel + vbQuestion + vbDefaultButton1
Title = [A5]
Response = MsgBox(Msg, Style, Title)

End With
End Sub


Sub SendMail2()

Dim ol As Object
Dim olmail As Object
Dim CurrFile As Object
Set ol = CreateObject("Outlook.Application")
Set olmail = ol.CreateItem(0)

With olmail
    .To = ""
    .Subject = [L5]
    .Body = ": " & [L7] & "  : " & [M74]
   ' .Attachments.Add "c:\data\essai.doc"
     .Send
Call Sounds
Dim Msg, Style, Title, Response

Msg = ": " & [L7] & "  : " & [M7]
Style = vbYesNoCancel + vbQuestion + vbDefaultButton1
Title = [L5]
Response = MsgBox(Msg, Style, Title)

End With
End Sub

Sub SendMail3()

Dim ol As Object
Dim olmail As Object
Dim CurrFile As Object
Set ol = CreateObject("Outlook.Application")
Set olmail = ol.CreateItem(0)

With olmail
    .To = ""
    .Subject = [W5]
    .Body = ": " & [W7] & "  : " & [X7]
   ' .Attachments.Add "c:\data\essai.doc"
     .Send
Call Sounds
Dim Msg, Style, Title, Response

Msg = ": " & [W7] & "  : " & [X7]
Style = vbYesNoCancel + vbQuestion + vbDefaultButton1
Title = [W5]
Response = MsgBox(Msg, Style, Title)

End With
End Sub

Sub SendMail4()

Dim ol As Object
Dim olmail As Object
Dim CurrFile As Object
Set ol = CreateObject("Outlook.Application")
Set olmail = ol.CreateItem(0)

With olmail
    .To = ""
    .Subject = [AH5]
    .Body = ": " & [AH7] & "  : " & [AI7]
   ' .Attachments.Add "c:\data\essai.doc"
     .Send
Call Sounds
Dim Msg, Style, Title, Response

Msg = ": " & [AH7] & "  : " & [AI7]
Style = vbYesNoCancel + vbQuestion + vbDefaultButton1
Title = [RD5]
Response = MsgBox(Msg, Style, Title)

End With
End Sub

Sub SendMail5()

Dim ol As Object
Dim olmail As Object
Dim CurrFile As Object
Set ol = CreateObject("Outlook.Application")
Set olmail = ol.CreateItem(0)

With olmail
    .To = ""
    .Subject = [AS5]
    .Body = ": " & [AS7] & "  : " & [AT7]
   ' .Attachments.Add "c:\data\essai.doc"
     .Send
Call Sounds
Dim Msg, Style, Title, Response

Msg = ": " & [AS7] & "  : " & [AT7]
Style = vbYesNoCancel + vbQuestion + vbDefaultButton1
Title = [RP5]
Response = MsgBox(Msg, Style, Title)

End With
End Sub

Bloomby
 
Re : Problème de Boucle (n'arrete pas)

Re,

Oui, j'ai bien compris que tu voulais faire une boucle mais tel que c'est écrit, le test initial ne sert à rien puisque la condition est toujours "VRAI" et la macro va envoyer 23 mails et 23 msgbox puisque la réponse n'est pas testée et que l'on réponde Oui, Non ou annuler, la macro continue.

@+

Gael
 
Re : Problème de Boucle (n'arrete pas)

Bonjour Gael merci de l'information,
est-ce que tu aurais une solution pour palier à ce problème,

idéalement j'aimerais ne pas avoir à cliquer sur oui ou non étant donnée que j'aimerais laisser mon ordinateur ouvert et recevoir un message au travail,

mais si c'est impossible je ferais avec
merci
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
932
Réponses
4
Affichages
743
  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
466
Réponses
3
Affichages
926
Retour