Images de la signature qui ne suivent pas
Bonjour,
Dans la macro ci-dessous, le texte de ma signature est bien inséré mais les images ne s'affichent pas.
Après quelques recherches sur le net, j'ai transformé .body en .HTMLbody et essayé de mettre les images au même endroit que le fichier htm de ma signature mais cela ne fonctionne pas mieux.
Une idée ?
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
91
|
Sub mail()
' Enregistrement en PDF et envoi par mail
Dim Sourcewb As Workbook
Dim destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim SigString As String
Dim Signature As String
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
'Copie la feuille active comme nouvelle feuille
ActiveSheet.Copy
Set destwb = ActiveWorkbook
'Désactiver fenêtre de compatibilité
Application.DisplayAlerts = False
'----------------------------------------------------------------------------
'Sauvegarde la nouvelle feuille/L'envoie par mail/La supprime ... ou pas
'----------------------------------------------------------------------------
TempFilePath = "C:\Pointages\"
TempFileName = Range("AG2").Value
Set OutApp = CreateObject("outlook.application")
Set OutMail = OutApp.CreateItem(0)
With destwb
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=TempFilePath & "NOM SEMAINE" & TempFileName & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False ' sauvegarde du fichier au format pdf
' Ajout pour signature 23-12-2020
SigString = Environ("appdata") & "\Microsoft\Signatures\TOTO.htm"
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
' Fin Ajout pour signature
On Error Resume Next
With OutMail
.To = "destinataire1@entreprise.com"
.CC = ""
.bcc = "destinataire2@entreprise.com"
.Subject = "Pointage"
.Attachments.Add TempFilePath & "NOM SEMAINE" & TempFileName & ".pdf"
.HTMLBody = "texte du mail<BR><BR>" & Signature
.display 'ou alors utiliser
'.Send 'pour envoi
End With
On Error GoTo 0
.Close savechanges:=False
End With
'Effacer le fichier envoyé
'Kill TempFilePath & TempFileName & ".pdf"
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function |
Merci.
EDIT : J'ai essayé ce code mais je n'ai pas du tout de signature : http://learnexcelmacro.com/wp/2016/1...l-sent-by-vba/
