corps de texte mail et signature
Bonjour Lrexcel, Bonjour le forum,
Je n'utilise pas Excel 2007 (2003). Néanmoins, si cela peut t'aider.
L'idée consiste à créer une image temporaire depuis une feuille de ton classeur Excel déclarée en début de module et de la coller dans ton corps de texte puis d'envoyer ton mail.
Ces 2 dernières actions étant activées par Sendkeys.
L'image (ici "corps_1") comporte du texte, donc une signature mais aussi un logo.
Dans mon classeur, j'ai un tableau Excel comportant les adresses, pièces jointes,etc...
Je te livre mon traitement brut. A adapter.
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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
| Const Img_temp As String = "Monrépertoire\sens_interdit.jpg"
Sub Envoi_Documents()
'Utilise la liaison anticipée
'Requiert une référence à la bibliothèque d'objets Outlook
Dim Applic_Outlook As Outlook.Application
Dim MonItem As Outlook.MailItem
Dim Document As Range
Dim Objet_Mail As String
Dim Adresse_Mail As String
Sheets("Mail").Visible = True
Sheets("Mail").Select
Application.ScreenUpdating = True
'Quadrillage
ActiveWindow.DisplayGridlines = False
'Crée l'objet Outlook
Set Applic_Outlook = New Outlook.Application
'Parcourt en boucle les lignes
For Each Document In Sheets("Mail").Range("pièces")
[corps_message_1] = Document.Offset(0, 3)
[corps_message_2] = Document.Offset(0, 4)
'Obtenir les données
Objet_Mail = Document.Offset(0, -1)
Adresse_Mail = Document.Offset(0, -3)
'Créer l'élément de mail et le transmettre
Set MonItem = Applic_Outlook.CreateItem(olMailItem)
With MonItem
.To = Adresse_Mail
.Subject = Objet_Mail
If Not IsEmpty(Document.Offset(0, -2)) Then .CC = Document.Offset(0, -2)
.Categories = "Daily"
.Attachments.Add Document
For I = 1 To 2
If Not IsEmpty(Document.Offset(0, I)) Then
Fichier_joint = "Monrépertoire\" & Document.Offset(0, I).Value
.Attachments.Add Fichier_joint
End If
Next
If Not IsEmpty(Adresse_Mail_CC) Then _
.CC = Adresse_Mail_CC
.Display
End With
'copie du corps de texte dans le corps de message
Call Plage_Mail
Application.Wait (Now + TimeValue("0:00:01"))
AppActivate Objet_Mail & " - Message", 0 ' Active Outlook
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "^v", True ' coller
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "%v", True ' Envoi du message
Application.CutCopyMode = False
Next
Set Applic_Outlook = Nothing
ActiveWindow.DisplayGridlines = True
End Sub
Sub Plage_Mail()
Call Image_Temporaire
End Sub
Sub Image_Temporaire(Optional dummy As Byte)
Dim cellule_corp As Range
Dim image_chart As ChartObject
Set cellule_corp = Range("corps_1")
cellule_corp.CopyPicture xlScreen, xlBitmap
With cellule_corp
Set image_chart = ActiveSheet.ChartObjects.Add( _
.Left, .Top, .Width + 5, .Height + 5)
End With
With image_chart.Chart
.Paste
.Export Filename:=Img_temp
End With
image_chart.Delete
Set image_chart = Nothing
Set cellule_corp = Nothing
End Sub |
Cordialement.
Marcel
corp de mail et signature
Rebonjour le forum,
Merci beucoups Marcel pour cette initiative, bon j'ai essayer d'utiliser ton code mais ça marche pas avec office 2007 en plus c vraiment compliquer pour un débutant :cry:
"LES EXPERTS DU FORUM" comment je peux adapter le code de Marcel.
SINON JE VAIS M'EXPLOSER AND YOU WILL FEEL GUILTY FOR ALL YOUR LIVES;)
MERCI D'AVANCE
