Correcteur orthographique disparait lorsque décoche word pour modifier mail

**Plc8919** · 08/03/2013, 12h46

Bonjour,

J'ai programmé des lancements de mail automatiques au format HTML du fait que j'ai besoin d'une mise en forme des mails, ainsi que la présence de tableaux que je mets dans le corps de mail tout en gardant leur format d'origine.

Pour cela je dois décocher dans les options outlook, la case "UTILISER MICROSOFT OFFICE WORD 2003 POUR MODIFIER MESSAGES ELECTRONIQUES".

Cependant en faisant ça, je perds le correcteur orthographique présent lorsque j'écris des mails.

Auriez-vous une solution à ce problème ? Une alternative ?

Cdlt.

**Oliv-** · 11/03/2013, 14h13

Bonjour,
Tu dois pouvoir conserver word entant qu'éditeur et envoyer des Emails en HTML, quel code utilise tu ?

**Plc8919** · 11/03/2013, 18h09

Bonjour,

Merci pour l'attention portée à ma question, le code suivant que j'utilise incrémente plusieurs tableaux selon le jour de la semaine, il est un peu long (et j'ai supprimé des infos).

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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
 
Public Sub mailbis()
''''''''''''''''''''''''''''''''
'DANS OUTLOOK, ALLEZ DANS OUTILS>OPTIONS>FORMAT DU COURRIER, BIEN DECOCHER "UTILISER MICROSOFT OFFICE WORD 2003 POUR MODIFIER MESSAGES ELECTRONIQUES"
''''''''''''''''''''''''''''''''
Set MonOutlook = CreateObject("Outlook.Application")
Set MonMessage = MonOutlook.CreateItem(0)
Dim d As Date
Dim str, WbCurve, WbTableaux, WbStress, msg_CONV, msg_GED, msg_CED, msg_EDBU As String
Dim ws, wks As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim rng3 As Range
Dim rng4 As Range
Dim BookQ As Workbook
Dim File As String
Dim FilePath, FilePath2 As String
 
If ThisWorkbook.Sheets("General").GEDOptionButton.Value = True Then
    str = "GED"
ElseIf ThisWorkbook.Sheets("General").EDBUOptionButton.Value = True Then
    str = "EDBU"
Else
    str = "CONV"
End If
 
'variables
d = ThisWorkbook.Sheets("General").Cells(13, 5).Value
FilePath = "xx"
'workbook - curve
WbCurve = "xx.xls"
'workbook - tableaux
WbTableaux = "Tableaux" & ".xls"
'workbook - Template Stress 
FilePath2 = xx
WbStress = "Template Stress .xls"
 
'test if "Template Stress.xls" is open or not
For Each BookQ In Workbooks
    If BookQ.Name = WbStress Then
        If Weekday(d) = vbFriday And ThisWorkbook.Sheets("General").EDBUOptionButton.Value = True Then
        Else
            MsgBox "Template Stress.xls IS NOT OPEN!"
            Exit Sub
        End If
    End If
Next BookQ
 
 
'données à insérer dans mail
If Weekday(d) = vbFriday And ThisWorkbook.Sheets("General").EDBUOptionButton.Value = True Then
    Set rng = Nothing
    Set rng2 = Nothing
    Set rng3 = Nothing
    Set rng4 = Nothing
    For Each BookQ In Workbooks
        If BookQ.Name = WbCurve Then
            BookQ.Activate
            Set rng = BookQ.Sheets(1).Range("B10:C17")
        ElseIf BookQ.Name = WbTableaux Then
            BookQ.Activate
            Set rng2 = BookQ.Sheets(1).Range("H10:K11")
            If BookQ.Sheets(1).Cells(11, 1).Value <> "" Then
                Set rng3 = BookQ.Sheets(1).Range(Cells(10, 1), Cells(Cells(BookQ.Sheets(1).Rows.count, 4).End(xlUp).Row, 4))
            Else
                BookQ.Sheets(1).Cells(1, 1).Value = "RAS"
                Set rng3 = BookQ.Sheets(1).Cells(1, 1)
            End If
        ElseIf BookQ.Name = WbStress Then
                BookQ.Activate
                Set rng4 = BookQ.Sheets("Synthese").Range("H2:L9")
        End If
    Next BookQ
Else
    Set rng = Nothing
    Set rng2 = Nothing
    Set rng3 = Nothing
    For Each BookQ In Workbooks
        If BookQ.Name = WbCurve Then
            BookQ.Activate
            Set rng = BookQ.Sheets(1).Range("B10:C17")
        ElseIf BookQ.Name = WbTableaux Then
            BookQ.Activate
            Set rng2 = BookQ.Sheets(1).Range("H10:K11")
            If BookQ.Sheets(1).Cells(11, 1).Value <> "" Then
                Set rng3 = BookQ.Sheets(1).Range(Cells(10, 1), Cells(Cells(BookQ.Sheets(1).Rows.count, 4).End(xlUp).Row, 4))
            Else
                BookQ.Sheets(1).Cells(1, 1).Value = "RAS"
                Set rng3 = BookQ.Sheets(1).Cells(1, 1)
            End If
        End If
    Next BookQ
End If
 
'If ThisWorkbook.Sheets("General").EDBUOptionButton.Value = True Then
'    For Each BookQ In Workbooks
'        If BookQ.Name = WbStress Then
'            If Weekday(d) = vbFriday Then
'                BookQ.Activate
'                Set rng4 = BookQ.Sheets("Synthese").Range("H2:L9")
'            End If
'        End If
'    Next BookQ
'End If
 
'Mail subject
sub_GED = "GED report as of " & Format(d, "dd/mm/yyyy")
sub_CED = "CED report as of " & Format(d, "dd/mm/yyyy")
'sub_EDBU = "EDBU report as of " & Format(d, "dd/mm/yyyy")
sub_CONV = "CONV report as of " & Format(d, "dd/mm/yyyy")
 
 
'msg GED
msg_GED = ""
msg_GED = msg_GED & "<HEAD>"
msg_GED = msg_GED & "<BODY>"
msg_GED = "Hi," & "<br><br>"
msg_GED = msg_GED & "Please find attached the GED report as of " & Format(d, "dd/mm/yyyy") & ":" & "<br><br><br><br><br>"
msg_GED = msg_GED & "<FONT color=""red"" size = 3><b>Please update the following curves:</FONT></b>" & "<br><br>"
msg_GED = msg_GED & "RAS" & "<br><br><br><br><br>"
msg_GED = msg_GED & "Regards," & "<br><br>"
msg_GED = msg_GED & "<b>" & Application.UserName & "</b>"
msg_GED = msg_GED & "</BODY>"
msg_GED = msg_GED & ""
msg_GED = "<DIV align=left><FONT face=Arial color=#H00000000 size=2> " & msg_GED & " </FONT></DIV>"
 
'msg CED
msg_CED = ""
msg_CED = msg_CED & "<HEAD>"
msg_CED = msg_CED & "<BODY>"
msg_CED = "Hi," & "<br><br>"
msg_CED = msg_CED & "Please find attached the CED report as of " & Format(d, "dd/mm/yyyy") & ":" & "<br><br><br><br><br>"
msg_CED = msg_CED & "<FONT color=""red"" size = 3><b>Please update the following curves:</FONT></b>" & "<br><br>"
msg_CED = msg_CED & "RAS" & "<br><br><br><br><br>"
msg_CED = msg_CED & "Regards," & "<br><br>"
msg_CED = msg_CED & "<b>" & Application.UserName & "</b>"
msg_CED = msg_CED & "</BODY>"
msg_CED = msg_CED & ""
msg_CED = "<DIV align=left><FONT face=Arial color=#H00000000 size=2> " & msg_CED & " </FONT></DIV>"
 
'msg conv
msg_CONV = ""
msg_CONV = msg_CONV & "<HEAD>"
msg_CONV = msg_CONV & "<BODY>"
msg_CONV = "Hi," & "<br><br>"
msg_CONV = msg_CONV & "Please find attached the CONV report as of " & Format(d, "dd/mm/yyyy") & ":" & "<br><br>"
msg_CONV = msg_CONV & RangetoHTML(rng) & RangetoHTML2(rng2) & "<br><br><br>"
msg_CONV = msg_CONV & "<FONT color=""red"" size = 3><b>Please update the following curves:</FONT></b>" & "<br><br>"
msg_CONV = msg_CONV & RangetoHTML3(rng3) & "<br><br><br>"
msg_CONV = msg_CONV & "Regards," & "<br><br>"
msg_CONV = msg_CONV & "<b>" & Application.UserName & "</b>"
msg_CONV = msg_CONV & "</BODY>"
msg_CONV = msg_CONV & ""
msg_CONV = "<DIV align=left><FONT face=Arial color=#H00000000 size=2> " & msg_CONV & " </FONT></DIV>"
 
'msg EDBU
If Weekday(d) = vbFriday Then
    sub_EDBU = "EDBU report as of " & Format(d, "dd/mm/yyyy") & "  (With Stress)"
    msg_EDBU = ""
    msg_EDBU = msg_EDBU & "<HEAD>"
    msg_EDBU = msg_EDBU & "<BODY>"
    msg_EDBU = "Hi," & "<br><br>"
    msg_EDBU = msg_EDBU & "Please find attached the EDBU report as of " & Format(d, "dd/mm/yyyy") & ":" & "<br><br>"
    msg_EDBU = msg_EDBU & RangetoHTML(rng) & RangetoHTML2(rng2) & "<br><br><br>"
    msg_EDBU = msg_EDBU & "Please find there the Stress report on EDBU as of " & Format(d, "dd/mm/yyyy") & ":" & "<br><br>"
    msg_EDBU = msg_EDBU & RangetoHTML4(rng4) & "<br><br><br>"
    msg_EDBU = msg_EDBU & "<FONT color=""red"" size = 3><b>Please update the following curves:</FONT></b>" & "<br><br>"
    msg_EDBU = msg_EDBU & RangetoHTML3(rng3) & "<br><br><br>"
    msg_EDBU = msg_EDBU & "Regards," & "<br><br>"
    msg_EDBU = msg_EDBU & "<b>" & Application.UserName & "</b>"
    msg_EDBU = msg_EDBU & "</BODY>"
    msg_EDBU = msg_EDBU & ""
    msg_EDBU = "<DIV align=left><FONT face=Arial color=#H00000000 size=2> " & msg_EDBU & " </FONT></DIV>"
Else
    sub_EDBU = "EDBU report as of " & Format(d, "dd/mm/yyyy")
    msg_EDBU = ""
    msg_EDBU = msg_EDBU & "<HEAD>"
    msg_EDBU = msg_EDBU & "<BODY>"
    msg_EDBU = "Hi," & "<br><br>"
    msg_EDBU = msg_EDBU & "Please find attached the EDBU report as of " & Format(d, "dd/mm/yyyy") & ":" & "<br><br>"
    msg_EDBU = msg_EDBU & RangetoHTML(rng) & RangetoHTML2(rng2) & "<br><br><br>"
    msg_EDBU = msg_EDBU & "<FONT color=""red"" size = 3><b>Please update the following curves:</FONT></b>" & "<br><br>"
    msg_EDBU = msg_EDBU & RangetoHTML3(rng3) & "<br><br><br>"
    msg_EDBU = msg_EDBU & "Regards," & "<br><br>"
    msg_EDBU = msg_EDBU & "<b>" & Application.UserName & "</b>"
    msg_EDBU = msg_EDBU & "</BODY>"
    msg_EDBU = msg_EDBU & ""
    msg_EDBU = "<DIV align=left><FONT face=Arial color=#H00000000 size=2> " & msg_EDBU & " </FONT></DIV>"
End If
 
'liste destinataires
desto_GED = x
destcc_GED = xx
 
desto_CED =x
destcc_CED = xx
 
desto_EDBU = x
destcc_EDBU = xx
 
desto_CONV = x
destcc_CONV = xx
 
If ThisWorkbook.Sheets("General").GEDOptionButton.Value = True Then
    sub_mail = sub_GED
    msg = msg_GED
    desto = desto_GED
    destcc = destcc_GED
    File = FilePath & WbCurve
    str = "GED"
ElseIf ThisWorkbook.Sheets("General").CEDOptionButton.Value = True Then
    sub_mail = sub_CED
    msg = msg_CED
    desto = desto_CED
    destcc = destcc_CED
    File = FilePath & WbCurve
ElseIf ThisWorkbook.Sheets("General").EDBUOptionButton.Value = True Then
    sub_mail = sub_EDBU
    msg = msg_EDBU
    desto = desto_EDBU
    destcc = destcc_EDBU
    If Weekday(d) = vbFriday Then
        File = ""
    Else
        File = FilePath & WbCurve
    End If
    str = "EDBU"
Else
    sub_mail = sub_CONV
    msg = msg_CONV
    desto = desto_CONV
    destcc = destcc_CONV
    File = FilePath & WbCurve
    str = "CONVERTIBLES"
End If
 
 
file_GED = xx
file_CED = xx
file_EDBU = xx
file_CONV = xx
 
With MonMessage
    .To = desto
    .CC = destcc
    .Subject = sub_mail
    'mail format HTML
    '.BodyFormat = olFormatHTML
    .HTMLBody = msg
    'test if there is an attachment or not
    If File = "" Then
        '.attachments.Add File
    Else
        .Attachments.Add File
    End If
    .Display
End With
 
'free object variables
Workbooks(WbTableaux).Sheets(1).Cells(1, 1).Clear
Set MonOutlook = Nothing
Set rng = Nothing
Set rng2 = Nothing
Set rng3 = Nothing
Set rng4 = Nothing
 
End Sub
 
Public Function RangetoHTML(rng As Range)
'----------------------
Dim FSO As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
 
rng.Copy 'on copie la plage de données
Set TempWB = Workbooks.Add(1) 'On créer un classeur temporaire qui reçoit la plage de données
 
With TempWB.Sheets(1)
    .Cells(1).PasteSpecial Paste:=8
    .Cells(1).PasteSpecial xlPasteValues, , False, False
    .Cells(1).PasteSpecial xlPasteFormats, , False, False
    .Cells(1).Select
    Application.CutCopyMode = False
    On Error Resume Next
    .DrawingObjects.Visible = True
    .DrawingObjects.Delete
    On Error GoTo 0
End With
 
'On exporte le classeur temporaire en html
With TempWB.PublishObjects.Add( _
     SourceType:=xlSourceRange, _
     Filename:=TempFile, _
     Sheet:=TempWB.Sheets(1).Name, _
     Source:=TempWB.Sheets(1).UsedRange.Address, _
     HtmlType:=xlHtmlStatic)
    .Publish (True)
End With
 
Set FSO = CreateObject("Scripting.FileSystemObject") 'on créer l'objet de script
Set ts = FSO.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                      "align=left x:publishsource=")
 
TempWB.Close savechanges:=False
 
'On supprime les fichiers temporaires résiduels
Kill TempFile
 
Set ts = Nothing
Set FSO = Nothing
Set TempWB = Nothing
 
End Function
 
Public Function RangetoHTML2(rng2 As Range)
'----------------------
Dim FSO As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
 
rng2.Copy 'on copie la plage de données
Set TempWB = Workbooks.Add(1) 'On créer un classeur temporaire qui reçoit la plage de données
 
With TempWB.Sheets(1)
    .Cells(1).PasteSpecial Paste:=8
    .Cells(1).PasteSpecial xlPasteValues, , False, False
    .Cells(1).PasteSpecial xlPasteFormats, , False, False
    .Cells(1).Select
    Application.CutCopyMode = False
    On Error Resume Next
    .DrawingObjects.Visible = True
    .DrawingObjects.Delete
    On Error GoTo 0
End With
 
'On exporte le classeur temporaire en html
With TempWB.PublishObjects.Add( _
     SourceType:=xlSourceRange, _
     Filename:=TempFile, _
     Sheet:=TempWB.Sheets(1).Name, _
     Source:=TempWB.Sheets(1).UsedRange.Address, _
     HtmlType:=xlHtmlStatic)
    .Publish (True)
End With
 
Set FSO = CreateObject("Scripting.FileSystemObject") 'on créer l'objet de script
Set ts = FSO.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML2 = ts.ReadAll
ts.Close
RangetoHTML2 = Replace(RangetoHTML2, "align=center x:publishsource=", _
                      "align=left x:publishsource=")
 
TempWB.Close savechanges:=False
 
'On supprime les fichiers temporaires résiduels
Kill TempFile
 
Set ts = Nothing
Set FSO = Nothing
Set TempWB = Nothing
 
End Function
 
Public Function RangetoHTML3(rng3 As Range)
'----------------------
Dim FSO As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
 
rng3.Copy 'on copie la plage de données
Set TempWB = Workbooks.Add(1) 'On créer un classeur temporaire qui reçoit la plage de données
 
With TempWB.Sheets(1)
    .Cells(1).PasteSpecial Paste:=8
    .Cells(1).PasteSpecial xlPasteValues, , False, False
    .Cells(1).PasteSpecial xlPasteFormats, , False, False
    .Cells(1).Select
    Application.CutCopyMode = False
    On Error Resume Next
    .DrawingObjects.Visible = True
    .DrawingObjects.Delete
    On Error GoTo 0
End With
 
'On exporte le classeur temporaire en html
With TempWB.PublishObjects.Add( _
     SourceType:=xlSourceRange, _
     Filename:=TempFile, _
     Sheet:=TempWB.Sheets(1).Name, _
     Source:=TempWB.Sheets(1).UsedRange.Address, _
     HtmlType:=xlHtmlStatic)
    .Publish (True)
End With
 
Set FSO = CreateObject("Scripting.FileSystemObject") 'on créer l'objet de script
Set ts = FSO.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML3 = ts.ReadAll
ts.Close
RangetoHTML3 = Replace(RangetoHTML3, "align=center x:publishsource=", _
                      "align=left x:publishsource=")
 
TempWB.Close savechanges:=False
 
'On supprime les fichiers temporaires résiduels
Kill TempFile
 
Set ts = Nothing
Set FSO = Nothing
Set TempWB = Nothing
 
End Function
 
Public Function RangetoHTML4(rng4 As Range)
'----------------------
Dim FSO As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
 
'If ThisWorkbook.Sheets("General").EDBUOptionButton.Value = True Then
    rng4.Copy 'on copie la plage de données
 
    Set TempWB = Workbooks.Add(1) 'On créer un classeur temporaire qui reçoit la plage de données
 
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
 
    'On exporte le classeur temporaire en html
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
 
    Set FSO = CreateObject("Scripting.FileSystemObject") 'on créer l'objet de script
    Set ts = FSO.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML4 = ts.ReadAll
    ts.Close
    RangetoHTML4 = Replace(RangetoHTML4, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
 
    TempWB.Close savechanges:=False
 
    'On supprime les fichiers temporaires résiduels
    Kill TempFile
 
    Set ts = Nothing
    Set FSO = Nothing
    Set TempWB = Nothing
'End If
End Function

Quand je lance le code sans décocher l'option word comme éditeur par défaut de mail, ca ne marche pas.

J'ai par ailleurs une question subsidiaire si jamais ça t'intéresse (en plus de la question principale) c'est que ce code ne marche pas si la date est vendredi (dans le code weekday(d)=vbfriday) il bloque sur le 4ème tableau (rgn4).

**Oliv-** · 12/03/2013, 16h41

Salut,
Quelle partie ne fonctionne pas avec word comme éditeur ? L'option HTML est elle bien selectionnée dans les options ?

Pour ton Weekday il faut indiquer le jour de début de semaine.
If Weekday(d,vbMonday) = vbFriday

**Plc8919** · 14/03/2013, 15h21

Quand je laisse word comme éditeur pour outlook et en ayant le format du message en HTML, dans le mail crée il n'y a que le premier tableau de copié au lieu des 3, et le texte a disparu.

Alors que si je décoche juste word comme éditeur cela fonctionne parfaitement.

Cependant, si j'enlève word comme éditeur par défaut je n'ai plus la correction orthographique.

P.S. Pour les dates merci de l'astuce cela marche bien.

**Oliv-** · 14/03/2013, 15h29

DAns ce cas difficile de voir sans le fichier !

Correcteur orthographique disparait lorsque décoche word pour modifier mail

VBA Outlook

Discussions similaires

Partager

Partager