Inclure l'image jpeg de ma signature dans macro envoi mail (Outlook)
Bonjour chers membres,
J'ai un fichier excel avec une macro qui permet d'envoyer le fichier par mail en incluant ma signature (qui a une image en jpg), cependant j'ai deux petits soucis:
Le premier c'est que le saut de lignes dans le corps de texte (Body) ne fonctionne pas dans mon code et le deuxième c'est que j'ai une erreur qui me dit que "la méthode globale de l'objet range a échouée" à ce niveau de mon code
Code:
1
2
3
| '...
Set cellule_corp = Range("corps_5")
cellule_corp.CopyPicture xlScreen, xlBitmap '... |
Je me suis aidé de tout ce que j'ai trouvé sur le net pour ce code mais j'ai pas vraiment compris comment inclure l'image de ma signature au niveau du "bug".
Voici mon code:
Vois tu ce qui pose problème s'in te plait?
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
| Sub EnvoiMail()
Const Img_temp As String = "N:\Application Data\Microsoft\Signatures\Médérick MONTOUT_fichiers\image002.jpg"
Dim OutlookApp As Object
Dim Mail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set Mail = OutlookApp.CreateItem(0)
Set mapiecejte = Mail.Attachments
With Mail
.To = "nicolas.carpentier@socgen.com" & ";" & "herve.delaunay@socgen.com"
.CC = "mes copies"
.Subject = "Demande d'habilitations"
.HTMLBody = "Bonjour," & vbCrLf & vbCrLf & "Merci de bien vouloir créer le profil suivant" & GetBoiler("N:\Application Data\Microsoft\Signatures\Médérick MONTOUT.htm")
.display
End With
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
Set Applic_Outlook = Nothing
Set Mail = Nothing
Set OutlookApp = Nothing
If Err.Number <> 0 Then
MsgBox Err.Description, 16, "Erreur"
MsgBox "le mail n'a pas pu être envoyé !", 16, "Information"
Else
MsgBox "Le mail a été bien envoyé !", 64, "Information"
End If
On Error GoTo 0
End Sub
Function GetBoiler(ByVal sFile As String) As String
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile("N:\Application Data\Microsoft\Signatures\Médérick MONTOUT.htm").OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function
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
On Error Resume Next
For Each Image In ActiveSheet.Charts
Image.Delete
Next
On Error GoTo 0
'à adapter ==> il s'agit du champ comprtant la signature
Set cellule_corp = Range("corps_5")
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 |
Merci d'avance pour toute aide!
Médérick
