Bonjour,

J'ai utilisé un module dont j'avoue ne pas avoir compris la substance.
Il fonctionne parfaitement dans mon environnement et utilisé par beaucoup de monde sans problème.
A l'époque où on me l'a proposé, c'était pour un problème de compatibilité ce qui fait qu'on passe par IE en sous-marin

Cependant pour une question de taille des cellules, j'aurais besoin d'envoyer deux plages au lieu d'une.
J'ai regardé union mais on ne peux pas porter sur plusieurs feuilles et de plus la plage résultante sera sous un format unique
je veux bien avoir deux tableaux différents dans le mail avec des largeurs de colonnes différentes.

J'ai vu des solutions, mais avant de changer complètement mon module, j'aurais aimé savoir s'il y a une possibilité dans mon code actuel.


Dans la séquence qui crée le codehtml puis-je en avoir 2 ?

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
 
Sub Send_Mail()
 
With ThisWorkbook.Sheets("Resultat")
Set Plage_Html = .Range("A1:Q" & .Range("A1048576").End(xlUp).Row)
End With
' >>>>> ma deuxième plage que je souhaiterais ajouter qui a une mise en forme différente des largeurs de colonnes
With ThisWorkbook.Sheets("Resultat2")
Set Plage_Html2 = .Range("A1:Q" & .Range("A1048576").End(xlUp).Row)
End With
 
' construction de la page HTML
    If Doc_Joint <> "" Then Set oAttach = ColAttach.Add(Doc_Joint)
     Plage_Html.Copy
     Set ie = CreateObject("internetexplorer.application")
    With ie
        .navigate "about:blank"
        Do: DoEvents: Loop While .readystate <> 4
       ' .Visible = True
        .document.body.innerhtml = "<div contenteditable=true></div>"
        Set div = .document.getelementsbytagname("DIV")(0)
        div.Focus: .ExecWB 13, 0: codehtml = div.innerhtml
        .Quit
    End With
    Application.CutCopyMode = False
Le code complet
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
 
Sub Send_Mail()
 
Application.ScreenUpdating = False
    Dim objOL As Object, ObjMail As Object '
    Dim oAttach As Object, ColAttach As Object
    Dim FootMessage As String
 
    Set objOL = CreateObject("Outlook.Application")
    Set ObjMail = objOL.CreateItem(0)
    Set ColAttach = ObjMail.Attachments
 
' on crée un clsseur temporaire pour le joindre
    Doc_Joint = Environ("userprofile") & "\Desktop\Resultat.xlsx"
    ThisWorkbook.Sheets("Resultat").Copy
    ActiveWorkbook.SaveAs Filename:=Doc_Joint
    ActiveWorkbook.Close
 
' zone à envoyer
 
With ThisWorkbook.Sheets("Resultat")
Set Plage_Html = .Range("A1:Q" & .Range("A1048576").End(xlUp).Row)
End With
 
' Liste des destinataires
    Dim Cel As Range
 
For Each Cel In Range("Desti")
    Adresses_Dest = Adresses_Dest & ";" & Cel
Next
 
' on ajoute l'expéditeur en C/C et on le sauvegarde pour mise à joour base
Adresses_CC = Adresses_CC & ";" & objOL.Session.Accounts.Item(1): Emetteur = objOL.Session.Accounts.Item(1)
 
' le titre
     Titre_Mess = Titre_Mess & "Etat journalier </H2>" '   <br H2 align=center>"
' L'objet
        Sujet_General = "Etat journalier du " & Now()
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
 
' construction de la page HTML
    If Doc_Joint <> "" Then Set oAttach = ColAttach.Add(Doc_Joint)
     Plage_Html.Copy
     Set ie = CreateObject("internetexplorer.application")
    With ie
        .navigate "about:blank"
        Do: DoEvents: Loop While .readystate <> 4
       ' .Visible = True
        .document.body.innerhtml = "<div contenteditable=true></div>"
        Set div = .document.getelementsbytagname("DIV")(0)
        div.Focus: .ExecWB 13, 0: codehtml = div.innerhtml
        .Quit
    End With
    Application.CutCopyMode = False
'Stop
    With ObjMail
        .To = Adresses_Dest
        .Cc = Adresses_CC
        .Subject = Sujet_General
        .HTMLBody = "<BODY align=center><FONT face=Arial color=#000080 size=2></FONT>" & _
            Titre_Mess & codehtml & FootMessage & "</BODY>"
 '        .send envoi direct
         .display   ' affichage avant envoi
          ' SendKeys "^{ENTER}" validation de l'envoi
 
    End With
     With Application
        .EnableEvents = True
    End With
 
'suppression du doc_temporaire
Kill Doc_Joint
 
 ' reinitialisation des variables
    Set oAttach = Nothing
    Set ColAttach = Nothing
    Set ObjMail = Nothing
    Set objOL = Nothing
    StrMessage = ""
    FootMessage = ""
    Titre_Mess = ""
    Adresses_Dest = ""
    Adresses_CC = ""
    Envoi_HTML = ""
    En_Copie = ""
    Doc_Joint = ""
    Sujet_Precision = ""
    Lg_Destinataire = 2
    MyTimeStamp = ""
    N_Record = ""
    Lien_Hyper_Flag = ""
 
'    MsgBox "Message envoyé"
'    Sheets("Menu").Activate
Application.ScreenUpdating = True
Merci pour vos suggestions
Denis