Bonjour,

je donne ma langue au chat...
j'ai utilise le code suivant :


Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
 Private Sub CommandButton101_Click()
 
 Dim Ws As Worksheet
 Dim ob As Object
 Dim Pieces, Adresse, ClasseurActif
 Dim OL As Object
 Dim OLmail As Object
 Dim Texte As String
 
 
 Sheets("contact").Select
 totalcontact = 1
 Do
 totalcontact = totalcontact + 1
 Loop Until (Range("A" & totalcontact) = "")
 
 
 
 Application.ScreenUpdating = False
 progression = 0
 
 nbcontact = 1
 Do
 nbcontact = nbcontact + 1
 labelprogession = nbcontact / totalcontact * 100
 progression = 200 * labelprogession / 100
 prenom = Sheets("contact").Range("A" & nbcontact).Value
 Nom = Sheets("contact").Range("B" & nbcontact).Value
 Adresse = Sheets("contact").Range("C" & nbcontact).Value
 
 
 Image_barre.Width = progression
 Label_barre.Caption = labelprogession & "%"
 DoEvents
 
 Application.ScreenUpdating = True
 
 
 
 'envoi du mail
 On Error Resume Next
Set OL = CreateObject("Outlook.Application") Set OLmail = OL.CreateItem(olMailItem) '0
 
 'enléve les messages d'alerte
 Application.DisplayAlerts = False
 'remet les messages d'alerte
 Application.DisplayAlerts = True
 'réactive le rafraichissement de l'écran
 Application.ScreenUpdating = True
 
 
 ' Adresse = "guil.pothier@gmail.com" 'pour exemple
 
 With OLmail
 .From = "guillaumepothier@hotmail.com"
 .To = Adresse
 .BodyFormat = olFormatHTML
 .Subject = "HMTL BODY du " & Date
 
 
 
 ' debut du message html
 Const SAUTLIGNE = "<br/>"
 
 
 
 .HTMLBody = "<body>"
 
 img1 = "1-4.jpg"
 img2 = "2-4.jpg"
 img3 = "3-4.jpg"
 img4 = "4-4.jpg"
 
 .Attachments.Add ThisWorkbook.Path & "\" & "1-4.jpg", olByValue, 0
 .Attachments.Add ThisWorkbook.Path & "\" & "2-4.jpg", olByValue, 0
 .Attachments.Add ThisWorkbook.Path & "\" & "3-4.jpg", olByValue, 0
 .Attachments.Add ThisWorkbook.Path & "\" & "4-4.jpg", olByValue, 0
 
 
 
 'Ecrit bonjour en gras, calibri, taille 40
 .HTMLBody = .HTMLBody & "<font face=""calibri"" size =""40"" color=""black""> hello <b>Bonjour ! " & prenom & " " & Nom & "</b></font>"
 'Saute deux lignes
 .HTMLBody = .HTMLBody & SAUTLIGNE & SAUTLIGNE
 'Ecrit le reste de l'entete
 
 .HTMLBody = .HTMLBody & SAUTLIGNE & SAUTLIGNE
 .HTMLBody = .HTMLBody & "<div align='center'><table>"
 .HTMLBody = .HTMLBody & "<tr>"
 .HTMLBody = .HTMLBody & "<td valign='middle'><b>test : <input type='text'>Ligne 1 - cols 1</input></b></td>"
 .HTMLBody = .HTMLBody & "<td valign='middle'><b><img src='" & img1 & "'>"
 .HTMLBody = .HTMLBody & "Ligne 1 - cols 2</b></td>"
 .HTMLBody = .HTMLBody & "<td valign='middle'><b><img src='" & img2 & "'>"
 .HTMLBody = .HTMLBody & "Ligne 1 - cols 3</b></td>"
 .HTMLBody = .HTMLBody & "</tr>"
 
 .HTMLBody = .HTMLBody & "<tr>"
 .HTMLBody = .HTMLBody & "<td valign='middle'><b><img src='" & img3 & "'>"
 .HTMLBody = .HTMLBody & "Ligne 2 - cols 1</b></td>"
 .HTMLBody = .HTMLBody & "<td valign='middle'><b><img src='" & img4 & "'>"
 .HTMLBody = .HTMLBody & "Ligne 2 - cols 2</b></td>"
 .HTMLBody = .HTMLBody & "<td valign='middle'><b>Ligne 2 - cols 3</b></td>"
 .HTMLBody = .HTMLBody & "</tr>"
 
 .HTMLBody = .HTMLBody & "</table></div>"
 
 .HTMLBody = .HTMLBody & "</body>"
 
 
 '.Display
 .Save
 .Send 'envoi automatique
 
 End With
 
 
 Loop Until (Range("A" & nbcontact) = "")
 
 
 End Sub
et ca marche..... uniquement sur Outlook.... mais pas sur Hotmail ou courrier ou gmail !!!!
Les images ne s'affichent pas... et le input text uniquement sur Gmail...

Nom : look.jpg Affichages : 2228 Taille : 35,6 Ko



Comment résoudre ces problèmes ?
Merci.
Guillaume.