Sellig
XLDnaute Nouveau
Bonjour
J’ai à nouveau besoin de vos services.
J’ai un tableau tout simple avec des dates d’anniversaires.
Lorsqu’un anniversaire tombe à la date du jour mon tableau affiche ‘’Aujourd’hui’’ dans la colonne ‘’S’’
A partir de là, j’ai installé cette macro qui m’envoie un mail sur Outlook. (Macro trouvée en partie sur internet)
Sub mail_outlook_COULEUR()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
For ligne = 3 To 20
If Range("S" & ligne) = "Aujourd'hui" Then
With OutMail 'début de la boucle
.To = "glefort@live.fr"
.Subject = "Anniversaire"
.HTMLBody = "<FONT COLOR=RED> Il y a un anniversaire à souhaiter aujourd'hui </FONT>" & "<br>" & _
.HTMLBody
.Send
'.Display 'affiche le mail avant d'envoyer
End With
End If
Next ligne
Set OutMail = Nothing 'nettoie la mémoire en nettoyant les variables
Set OutApp = Nothing 'nettoie la mémoire en nettoyant les variables
End Sub
Pour que ce tableau s’actualise à chaque ouverture du PC, j’ai un fichier Excel qui est installé dans shell:startup avec cette macro : (Macro trouvée en partie sur internet)
Sub ModifierFichier()
' Partie à modifier
NomFichier = "D:\DOSSIER GILLES\DIVERS\Dates anniversaires"
Feuille = "Feuil1" ' Modifiez la feuille à modifier
Addresse = "A1" ' Modifiez l'Adresse de la cellule à modifier
Valeur = 123 ' Modifiez Valeur à écrire
Application.ScreenUpdating = False ' Fige l'écran
Workbooks.Open NomFichier ' Ouvre le fichier
ActiveWorkbook.Sheets(Feuille).Range(Addresse) = Valeur ' Ecrit la valeur à l'adresse indiquée
'ActiveWorkbook.Close SaveChanges:=True ' Ferme le fichier en enregistrant.
ActiveWorkbook.Save
Application.Quit
End Sub
Jusque-là tout fonctionne correctement, même si ce n’est pas conventionnel à vos yeux. (J’accepte d’ailleurs toutes améliorations)
Mon objectif, consiste à insérer le prénom qui se trouve à gauche de la ligne ‘’Aujourd’hui’’ dans l’objet du mail.
Exemple : Subject = Anniversaire Laure.
J’arrive à sélectionner le nom à l’aide de cette macro mais je n’arrive pas à l’intégrer dans l’objet du mail.
Sub SelectNom()
Dim R As Range
Set R = ActiveSheet.Cells.Find("Aujourd'hui", , xlValues, xlWhole)
If Not R Is Nothing Then R.Select
Selection.Offset(0, -18).Select
End Sub
Si vous pouviez m’aider ce serait formidable.
Merci par avance
Bien cordialement
PS : ce n’est pas très urgent
J’ai à nouveau besoin de vos services.
J’ai un tableau tout simple avec des dates d’anniversaires.
Lorsqu’un anniversaire tombe à la date du jour mon tableau affiche ‘’Aujourd’hui’’ dans la colonne ‘’S’’
A partir de là, j’ai installé cette macro qui m’envoie un mail sur Outlook. (Macro trouvée en partie sur internet)
Sub mail_outlook_COULEUR()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
For ligne = 3 To 20
If Range("S" & ligne) = "Aujourd'hui" Then
With OutMail 'début de la boucle
.To = "glefort@live.fr"
.Subject = "Anniversaire"
.HTMLBody = "<FONT COLOR=RED> Il y a un anniversaire à souhaiter aujourd'hui </FONT>" & "<br>" & _
.HTMLBody
.Send
'.Display 'affiche le mail avant d'envoyer
End With
End If
Next ligne
Set OutMail = Nothing 'nettoie la mémoire en nettoyant les variables
Set OutApp = Nothing 'nettoie la mémoire en nettoyant les variables
End Sub
Pour que ce tableau s’actualise à chaque ouverture du PC, j’ai un fichier Excel qui est installé dans shell:startup avec cette macro : (Macro trouvée en partie sur internet)
Sub ModifierFichier()
' Partie à modifier
NomFichier = "D:\DOSSIER GILLES\DIVERS\Dates anniversaires"
Feuille = "Feuil1" ' Modifiez la feuille à modifier
Addresse = "A1" ' Modifiez l'Adresse de la cellule à modifier
Valeur = 123 ' Modifiez Valeur à écrire
Application.ScreenUpdating = False ' Fige l'écran
Workbooks.Open NomFichier ' Ouvre le fichier
ActiveWorkbook.Sheets(Feuille).Range(Addresse) = Valeur ' Ecrit la valeur à l'adresse indiquée
'ActiveWorkbook.Close SaveChanges:=True ' Ferme le fichier en enregistrant.
ActiveWorkbook.Save
Application.Quit
End Sub
Jusque-là tout fonctionne correctement, même si ce n’est pas conventionnel à vos yeux. (J’accepte d’ailleurs toutes améliorations)
Mon objectif, consiste à insérer le prénom qui se trouve à gauche de la ligne ‘’Aujourd’hui’’ dans l’objet du mail.
Exemple : Subject = Anniversaire Laure.
J’arrive à sélectionner le nom à l’aide de cette macro mais je n’arrive pas à l’intégrer dans l’objet du mail.
Sub SelectNom()
Dim R As Range
Set R = ActiveSheet.Cells.Find("Aujourd'hui", , xlValues, xlWhole)
If Not R Is Nothing Then R.Select
Selection.Offset(0, -18).Select
End Sub
Si vous pouviez m’aider ce serait formidable.
Merci par avance
Bien cordialement
PS : ce n’est pas très urgent
,
)
