Lancer une macro via une formule
Bonjour à tous,
je suis nouveau et tout débutant en programmation excell.
Je me suis déjà sorti de pas mal de galères grâce à de nombreuses recherches sur ce site mais là je sèche tout près du but!!!
Je suis étudiant en 2ème mécatronique et en stage en entreprise,
celle-ci me demande de faire un programme sur excell qui fera ceci:
envoie de mail automatique (via gmail de l'atelier) quand la date de maintenance de tel machine est atteinte.
voici mon problème:
J'ai réussi à créer une macro qui envoie bien un mail automatiquement quand une cellule se modifie, mais uniquement manuellement.
Via une formule ça ne fonctionne pas.
La formule que j'utilise est la condition si (si la date d'aujourd'hui atteint date de maintenance alors affichage maintenance cellule et envoie automatique du mail)
Je sais que c'est mon subprivate worksheet_change le problème, que je dois utiliser plutôt le worksheet_calculate.
Mais je n'arrive pas à utiliser celui-ci.
Voici mon code et celui de la feuil1 :
Code:
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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
| Sub EnvoiMailCDO()
Dim mMessage As Object
Dim mConfig As Object
Dim mChps
Set mConfig = CreateObject("CDO.Configuration")
mConfig.Load -1
Set mChps = mConfig.Fields
With mChps
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'Adapter suivant votre serveur de mail. (exemple pour Gmail.)=> Hotmail "smtp.live.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
'En principe, 25 fonctionne avec tout les serveurs.
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
'Vous pouvez essayer sans ces trois lignes
'Mais si votre serveur demande une authentification,
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = "1"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "adressemail"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "motdepasse"
'Si votre serveur demande une connexion sûre (SSL)
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = "true"
.Update
End With
Set mMessage = CreateObject("CDO.Message")
With mMessage
Set .Configuration = mConfig
.To = "adressemail"
.From = "adressemail"
.Subject = "test"
.TextBody = "Ce mail vous est envoyer pour tester la macros"
'Pour ajouter une pièce jointe, un fichier, classeur, image etc.
'.AddAttachment 'Chemin et nom complet du fichier à joindre
.Send
End With
Set mMessage = Nothing
'Pour un autre message, pas besoin de tout reconfigurer, il faut toutefois recréer un nouveau
'message à chaque fois.
Set mMessage = CreateObject("CDO.Message")
With mMessage
Set .Configuration = mConfig
.To = "adressemail"
.From = "adressemail"
.Subject = "C'est pour le deuxième test d'envoi mail"
.TextBody = "Ce mail vous est envoyer pour tester la macros" & Chr(13) _
& "et voir si le deuxième message est bien passer."
'Pour ajouter une pièce jointe, un fichier, classeur, image etc.
'.AddAttachment 'Chemin et nom complet du fichier à joindre
.Send
End With
Set mMessage = Nothing
'Libère les ressources
Set mConfig = Nothing
Set mChps = Nothing
End Sub |
feuil1:
Code:
1
2
3
4
5
6
7
8
9
10
| Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("I20")) Is Nothing Then
Select Case Target.Formula
Case "Maintenance"
Call EnvoiMailCDO
End Select
End If
End Sub |
Donc ici, cela fonctionne si je modifie la case I20 manuellement.
Merci d'avance pour l'aide!
