Bonjour le Forum,
Bon j'ai encore fait n'importe quoi je crois...
J'ai un fichier avec des prestations et des dates d'échéance pour chaque prestations. J'ai implémenté une macro qui m'ouvre 2 MsgBoxPerso quand :
1/ Les dates arrivent à échéance
2/ Les dates sont échues
J'ai essayé d'intégrer une macro d'envoi de mail sur le bouton valider des 2 MsgBoxPerso.
Cela fonctionne mais je rencontre 2 erreurs :
1/ Quand les dates sont échues (MsgBoxPerso((txt), "Alerte", vbCritical, "xxxx", "xxxxx") pour l'exemple) le mail s'ouvre bien mais le texte de la MsgBox lui ne remonte pas, ou plutôt je le vois furtivement mais il disparait
Le message pour les dates échues ne s'affiche que si les 2 MsgBoxPerso sont activées (cad uniquement s'il y a des dates échues ET qui arrivent à échéance)
2/Quand il y a des dates échues ET qui arrivent à échéance et que j'envoi un mail un chaque fois, tout va bien. Mais si je choisi de ne pas envoyer le premier mail la deuxième MsgBoxPerso s'affiche comme une MsgBox normale (et fais quand même l'action demandé).
A mon avis je place mal mes bouts de code dans la deuxième partie de celui-ci mais ça n'engage que moi. N'est pas Harry Potter qui veut... #apprentisorcierpastrèsdoué
Si vous pouviez me dire où j'ai fauté....
Merci pour vos explications !!
Le code en question :
Private Sub Worksheet_Activate()
Dim c As Range
Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("outlook.application")
Set OutlookMail = OutlookApp.createitem(0)
txt = ""
txt1 = ""
With Sheets("Feuil1")
For Each c In Range(.[P3], [P65536].End(xlUp))
If c <> "" Then
If c.Value < Date Then
If txt = "" Then txt = "Les dates ci-dessous sont échues :" & vbCrLf & vbCrLf
txt = txt & c.Offset(, -12) & " - Terminée le : " & c.Offset(, 0) & vbCrLf
ElseIf c.Value < Date + 30 Then
If txt1 = "" Then txt1 = "Les dates ci-dessous arrivent à échéance dans 1 mois ou moins :" & vbCrLf & vbCrLf
txt1 = txt1 & c.Offset(, -12) & " - Arrive à écheance le : " & c.Offset(, 0) & vbCrLf
End If
End If
Next c
If txt <> "" Then Rep = MsgBoxPerso((txt), "Alerte", vbCritical, "Envoi Mail", "Ne rien faire")
Select Case Rep
Case 1
With OutlookMail
.Subject = "Des prestations nécessitent votre attention"
.To = Sheets("Feuil2").Range("F7")
.Body = "Bonjour," & vbCrLf & vbCrLf & MsgBoxPerso & vbCrLf & "Merci de renouveler vos prestations ci-dessous svp." & vbCrLf & vbCrLf & "Cordialement,"
.Display
End With
End Select
If txt1 <> "" Then Rep = MsgBoxPerso((txt1), "Information", vbInformation, "Envoi Mail", "Ne rien faire")
Select Case Rep
Case 1
With OutlookMail
.Subject = "Des prestations nécessitent votre attention"
.To = Sheets("Infos Utiles Mali").Range("F10")
.Body = "Bonjour," & vbCrLf & vbCrLf & MsgBoxPerso & vbCrLf & "Merci de renouveler Merci de renouveler vos prestations ci-dessous svp." & vbCrLf & vbCrLf & "Cordialement,"
.Display
End With
End Select
End With
End Sub
Bon j'ai encore fait n'importe quoi je crois...
J'ai un fichier avec des prestations et des dates d'échéance pour chaque prestations. J'ai implémenté une macro qui m'ouvre 2 MsgBoxPerso quand :
1/ Les dates arrivent à échéance
2/ Les dates sont échues
J'ai essayé d'intégrer une macro d'envoi de mail sur le bouton valider des 2 MsgBoxPerso.
Cela fonctionne mais je rencontre 2 erreurs :
1/ Quand les dates sont échues (MsgBoxPerso((txt), "Alerte", vbCritical, "xxxx", "xxxxx") pour l'exemple) le mail s'ouvre bien mais le texte de la MsgBox lui ne remonte pas, ou plutôt je le vois furtivement mais il disparait
Le message pour les dates échues ne s'affiche que si les 2 MsgBoxPerso sont activées (cad uniquement s'il y a des dates échues ET qui arrivent à échéance)
2/Quand il y a des dates échues ET qui arrivent à échéance et que j'envoi un mail un chaque fois, tout va bien. Mais si je choisi de ne pas envoyer le premier mail la deuxième MsgBoxPerso s'affiche comme une MsgBox normale (et fais quand même l'action demandé).
A mon avis je place mal mes bouts de code dans la deuxième partie de celui-ci mais ça n'engage que moi. N'est pas Harry Potter qui veut... #apprentisorcierpastrèsdoué
Si vous pouviez me dire où j'ai fauté....
Merci pour vos explications !!
Le code en question :
Private Sub Worksheet_Activate()
Dim c As Range
Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("outlook.application")
Set OutlookMail = OutlookApp.createitem(0)
txt = ""
txt1 = ""
With Sheets("Feuil1")
For Each c In Range(.[P3], [P65536].End(xlUp))
If c <> "" Then
If c.Value < Date Then
If txt = "" Then txt = "Les dates ci-dessous sont échues :" & vbCrLf & vbCrLf
txt = txt & c.Offset(, -12) & " - Terminée le : " & c.Offset(, 0) & vbCrLf
ElseIf c.Value < Date + 30 Then
If txt1 = "" Then txt1 = "Les dates ci-dessous arrivent à échéance dans 1 mois ou moins :" & vbCrLf & vbCrLf
txt1 = txt1 & c.Offset(, -12) & " - Arrive à écheance le : " & c.Offset(, 0) & vbCrLf
End If
End If
Next c
If txt <> "" Then Rep = MsgBoxPerso((txt), "Alerte", vbCritical, "Envoi Mail", "Ne rien faire")
Select Case Rep
Case 1
With OutlookMail
.Subject = "Des prestations nécessitent votre attention"
.To = Sheets("Feuil2").Range("F7")
.Body = "Bonjour," & vbCrLf & vbCrLf & MsgBoxPerso & vbCrLf & "Merci de renouveler vos prestations ci-dessous svp." & vbCrLf & vbCrLf & "Cordialement,"
.Display
End With
End Select
If txt1 <> "" Then Rep = MsgBoxPerso((txt1), "Information", vbInformation, "Envoi Mail", "Ne rien faire")
Select Case Rep
Case 1
With OutlookMail
.Subject = "Des prestations nécessitent votre attention"
.To = Sheets("Infos Utiles Mali").Range("F10")
.Body = "Bonjour," & vbCrLf & vbCrLf & MsgBoxPerso & vbCrLf & "Merci de renouveler Merci de renouveler vos prestations ci-dessous svp." & vbCrLf & vbCrLf & "Cordialement,"
.Display
End With
End Select
End With
End Sub
Dernière édition: