Problème de Macro VBA pour envoyer un tableau avec sa mise en forme

**Marquisette65** · 06/02/2017, 14h47

Bonjour,

je vous écris car après de nombreuses recherches je n'arrive pas à créer la macro parfaite pour mon tableau.

Voilà mon problème: j'ai un classeur avec une quinzaine de feuilles, chaque feuille correspond à un client, sur chaque feuille le planning de l'année, où chaque mois est un tableau de 13 colonnes sur 43 lignes, jusque là tout va bien !
A chaque fin de mois je dois envoyer la sélection de cellules à chaque client. Jusqu'à présent je les imprimais mais j'aimerai mieux les envoyer par mail. Alors bien sûr je peux copier ma sélection dans un nouveau classeur et envoyer celui ci par mail mais, une petite macro serait quand même plus sympa !

alors en cherchant sur votre forum j'ai réussit à en faire une qui m’envoie la sélection que je lui demande, de la feuille active, sauf que ma mise en page de mon tableau initial est inexistante ! notamment les cellules fusionnées...
voici ma macro actuelle:

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
 
Sub Envois_récap()
 
Dim iMsg As Object, iConf As Object, Flds As Object
Dim strHTML As String
Dim i As Byte, j As Byte
 
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields
 
strHTML = ""
strHTML = strHTML & "<HEAD>"
strHTML = strHTML & "<BODY>"
strHTML = strHTML & "Bonjour, <BR><BR>vous trouverez ci joint le récap du mois.<BR><BR>"
strHTML = strHTML & "<TABLE BORDER>"
 
For i = 1 To 43 
    strHTML = strHTML & "<TR halign='middle'nowrap>"
    For j = 1 To 13 'nombre de colonnes
        strHTML = strHTML & "<TD align='center'><FONT COLOR='black'SIZE=3>" _
        & Cells(i, j) & "</FONT></TD>"
    Next j
    strHTML = strHTML & "</TR>"
Next i
 
strHTML = strHTML & "</TABLE>"
strHTML = strHTML & "<BR><BR>Cordialement."
strHTML = strHTML & "</BODY>"
strHTML = strHTML & ""
 
With Flds
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.orange.fr"
    .Update
End With
 
With iMsg
    Set .Configuration = iConf
     .To = "moi@hotmail.fr"
    .From = "toi@hotmail.fr"
    .Subject = "test récap"
    .HTMLBody = strHTML
    .Send
End With
 
End Sub

je suis prête à modifier ou a changer totalement de macro...

Merci pour votre aide !

**Menhir** · 06/02/2017, 14h55

Le plus simple est de faire une copie "image" ta sélection que tu peux ajouter un mail.
https://msdn.microsoft.com/fr-fr/lib.../ff193594.aspx

N'ayant jamais traiter des mail par macro, je ne peux pas te dire comment faire un copier d'image dans un mail.

**Jean-Philippe André** · 07/02/2017, 14h18

Salut,

en plus de cette source de la

que tu as deja adaptée
https://excel.developpez.com/faq/?pa...geCellulesMail
je te propose celle qui suit avec SendRangeByMail

**Marquisette65** · 08/02/2017, 14h05

Merci Jean-Philippe !

J'ai suivit ton conseil, j'ai essayé d'adapter "SendRangeByMail" avec le reste mais en vain...

ma première macro est capable d'envoyer un mail, celle là de créer un fichier avec ce que je veux dedans, mais mes talents s'arrêtent là, je n'arrive pas à faire envoyer ce fichier dans le mail!!!!
alors après une soirée et une matinée d'essais, je capitule !
pourrais tu jeter un œil et me sauver s'il te plait??????

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
Sub SendRangeByMail()
 
Dim rngeSend As Range
Dim iMsg As Object, iConf As Object, Flds As Object
Dim strHTML As String
Dim i As Byte, j As Byte
 
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields
 
strHTML = ""
strHTML = strHTML & "<HEAD>"
strHTML = strHTML & "<BODY>"
strHTML = strHTML & "Bonjour, <BR><BR>Voici le récap du mois :<BR><BR>"
strHTML = strHTML & ""
strHTML = strHTML & "<BR><BR>Cordialement.<BR>"
strHTML = strHTML & "</BODY>"
strHTML = strHTML & ""
 
 
With Flds
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.orange.fr"
    .Update
End With
 
 
With Application
       On Error Resume Next
 
      ' Demande à l'utilisateur de sélectionner la plage de cellule
 
      Set rngeSend = .InputBox(Prompt:="Sélectionner les cellules à envoyer.", Type:=8, Default:=.Selection.Address)
 
      ' rngeSend Is Nothing lorsque l'utilisateur ne fait aucun choix
 
       If rngeSend Is Nothing Then Exit Sub
 
      On Error GoTo 0
 
      ' Exporte la plage vers un fichier de type HTML ceci afin de respecter la mise en page de la plage
 
      .ActiveWorkbook.PublishObjects.Add(4, "C:\essai\XLRange.htm", rngeSend.Parent.Name, rngeSend.Address, 0, "", "").Publish True
 
 
With iMsg
    Set .Configuration = iConf
    .To = "toi@hotmail.fr"
    .From = "moi@hotmail.fr"
    .Subject = "test récap"
    .HTMLBody = strHTML
    .Send
End With
 
 
      ' Le fichier HTML n'est plus nécessaire
      Kill "C:\essai\XLRange.htm"
 
   End With ' With Application
 
End Sub

et merci pour les "balises code" c'est vrai que c'est plus lisible !

**Jean-Philippe André** · 08/02/2017, 14h11

Si tu veux que le fichier soit en piece jointe, il faut passer par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
With iMsg
'...
.Attachments.Add tonpathfichier
'...
End with

Invité · 08/02/2017, 14h15

Bonjour,

https://www.developpez.net/forums/d1...t/#post7968025

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
Sub test()
TableHtml = RangetoHTML(ActiveSheet.UsedRange)
MailEnvoi "smtp.googlemail.com", True, "My.Mail@gmail.com", "Pasw", 465, 10, "My.Mail@gmail.com", "Vous.Mail@gmail.com", "Copy@gmail.com", "Suivi des modifications.", TableHtml, ""
End Sub
Function RangetoHTML(rng As Range) As String
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2013
    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"
    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    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
    'Publish the sheet to a htm file
    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
    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
 
 
    'Close TempWB
    TempWB.Close savechanges:=False
    'Delete the htm file we used in this function
    Kill TempFile
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function
 
 
Public Sub MailEnvoi(Serveur, Identify, User, PassWord, Port, Delay, Expediteur, Dest, DestEnCopy, Objet, Body, Pj)
' sub pour envoyer les mails
Dim msg
Dim Conf
Dim Config
Dim ess
Dim splitPj
Dim IsplitPj
Set msg = CreateObject("CDO.Message") 'pour la configuration du message
Set Conf = CreateObject("CDO.Configuration") '  pour la configuration de l'envoi
Dim strHTML
 
Set Config = Conf.Fields
 
' Configuration des parametres d'envoi
'(SMTP - Identification - SSL - Password - Nom Utilisateur - Adresse messagerie)
With Config
If Identify = True Then
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = User
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = PassWord
End If
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = Port
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Serveur
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = Delay
    .Update
 
End With
 
 
'Configuration du message
'If E_mail.Sign.Value = Checked Then Convert ServeurFrm.SignTXT, ServeurFrm.Text1
 
With msg
    Set .Configuration = Conf
    .To = Dest
  .cc = DestEnCopy
    .FROM = Expediteur
    .Subject = Objet
'
 
    .HTMLBody = Body '"<p align=""center""><font face=""Verdana"" size=""1"" color=""#9224FF""><b><br><font face=""Comic Sans MS"" size=""5"" color=""#FF0000""></b><i>" & body & "</i></font> " 'E_mail.ZThtml.Text
            If Pj <> "" Then
        splitPj = Split(Pj & ";", ";")
 
        For IsplitPj = 0 To UBound(splitPj)
            If Trim("" & splitPj(IsplitPj)) <> "" Then
                .AddAttachment Trim("" & splitPj(IsplitPj))
            End If
        Next
 
    End If
    .Send 'envoi du message
 
End With
' reinitialisation des variables
Set msg = Nothing
Set Conf = Nothing
Set Config = Nothing
 
End Sub

**Marquisette65** · 08/02/2017, 17h23

Merci Jean-Philippe,

visiblement ça fonctionne mais ça m'envoit un fichier.bin, qu'est ce que c'est que cette bête ?????

Merci Dysorthographie,

mais mes connaissances sont trop maigres, je n'arrive pas à l'adapter pour qu'il fonctionne...

Invité · 08/02/2017, 17h43

Envoyé par Marquisette65

Merci Dysorthographie,

mais mes connaissances sont trop maigres, je n'arrive pas à l'adapter pour qu'il fonctionne...

Difficile a dire vue que j'ai mis tout le code utile dans le message et que dans la sub test tu n'a juste qu'a compléter le manque UsedRange par la plage de cellules que tu veux envoyer ainsi que les informations pour l'envoi de mails MailEnvoi(seveur,login,destinataire,etc...)

**patricktoulon** · 08/02/2017, 23h16

bonsoir a tous

je suis étonné que personne ne te l'ai encore dit!!!
aucune des fonctions ou procédures natives de vba a excel y compris sendmail ne te rendra la mise en formea 100% je dis bien aucune sauf si tu n'a pas de fusion et que les bordures et tout propriétés de format ne dépasse pas ce que peut reproduire le html et dieu sais qu'il y a beaucoup de différence

tu trouvera dans les contributions ma contrib grille excel to html qui a été pendant un bon moment celle que je me suis servi mais quand même limité en terme de format et pourtant déjà bien travaillé

alors récemment j'ai revu la copie afin de rendre la table html obtenue au plus proche de la table exel (il y a quand même des toute petite choses impossible mais visuellement on est a 98% identique

voila donc ma version 2017 de la fonction
il y a donc

la fonction de convertion (exc el/html)
la fonction convertion de code couleur excel /html
la fonction conversion borderstyle pour les bordures
la fonction textformaté (qui reprends l'idée de ma fonction "byspan" de la contribution ) mais qui est plus propre au rendu final en terme de double balise
et donc dans cette version enfin le wraptext est pris en compte

bref il y en aurait beaucoup a dire mais je préfère le faire dans la mise a jour de ma contribution
en attendant voila le code module au complet suivi de la démo animée
colle ca dans un module standard et adapte ta plage dans la sub """TESTENDOM3"""

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
Sub TESTENDOM3()
   Dim PLAGE As Range, code As String, IE As Object
    Set PLAGE = Sheets(1).Range("A4:C" & Cells(Rows.Count, 1).End(xlUp).Row) 'adqapter la plage ici
    code = range_to_html_DOM3(PLAGE, True)
    Set IE = CreateObject("internetexplorer.application")
    With IE
        .Visible = True: .Left = 100: .Navigate "about:blank"    ' la position de la fenetre ie est en dehors du chanps de l'ecran (pas la peine dela voir ca n'est pas necessaire
        .Document.write code
    End With
End Sub
Function range_to_html_DOM3(PLAGE, Optional en_couleur As Boolean = False) As String
 
    Dim TD, TR, Doc, Table, cel As Range, V, TA, VRL, TAL, i As Long, lig As Long, col As Long, mesTD, B As Boolean
Dim rangeleft As Range, rangeTOP As Range, rangeBOTTOM As Range, RL, R
    Set Doc = CreateObject("htmlfile")
    With Doc
        .write "<Table id=""tabl"" cellspacing=15 cellpadding=0 style=""table-layout: fixed;border-collapse:collapse;""></table>"
        Set Table = .getelementbyid("tabl"): Table.Style.Width = Round(PLAGE.Width * 1.75) & "px":
        For lig = PLAGE.Row To PLAGE.Row + (PLAGE.Rows.Count - 1)
            Set TR = .createElement("TR")
            Table.appendchild (TR)
            For col = PLAGE.Column To PLAGE.Column + (PLAGE.Columns.Count - 1)
                Set cel = Cells(lig, col).MergeArea
                If .getelementbyid(cel.Address) Is Nothing Then
                    Set TD = .createElement("TD")
                    TD.ID = cel.Address: TD.rowspan = cel.Rows.Count: TD.colspan = cel.Columns.Count: TD.Style.Border = "0.1pt solid #CED8F6"
                    TD.Style.Width = Round(cel.Width * 1.7) & "px": TD.Style.Height = Round(cel.Height * 1.6666666) & "px"
                    If cel.WrapText = True Then TD.Style.WordWrap = "break-word"
                    V = cel.VerticalAlignment: VRL = Switch(V = xlTop, "top", V = xlBottom, "bottom", V = xlCenter, "middle"): TD.Style.verticalAlign = VRL
                    TA = cel.HorizontalAlignment: TAL = Switch(TA = xlLeft, "left", TA = xlCenter, "center", TA = xlRight, "right"): If Not IsNull(TAL) Then TD.Style.textAlign = TAL
                    If en_couleur Then
                        If cel.Cells(1).Value <> "" Then TD.innerhtml = text_formaté(cel.Cells(1))
                        TD.Style.bordertop = borderstyle(cel.Borders(xlEdgeTop))
                        TD.Style.borderleft = borderstyle(cel.Borders(xlEdgeLeft))
                        TD.Style.borderbottom = borderstyle(cel.Borders(xlEdgeBottom))
                        TD.Style.borderright = borderstyle(cel.Borders(xlEdgeRight))
                        TD.Style.backgroundcolor = coul_XL_to_coul_HTMLX(cel.Interior.Color)
                    Else
                        TD.innerhtml = IIf(cel.Cells(1).Value <> "", cel.Cells(1).Value, "")
                    End If
                    'corection des marginright et marginleft du texte dans les cellules HTML
                    If TD.Children.Length > 0 Then
                        For i = 1 To TD.Children.Length - 1
                        TD.Children(i).Style.margin = "0.5pt"
                        Next
                        TD.LastChild.Style.MarginRight = "3px": TD.FirstChild.Style.MarginLeft = "3px"
                    Else
                        If TD.innertext <> "" Then TD.FirstChild.Style.MarginRight = "3px"
                    End If
                End If
                TR.appendchild (TD)
            Next
        Next
 
 
        'correction des bordure gauche et droite en cas de fusion sur plusieurs lignes
        Set mesTD = .getelementsbytagname("TD")
        For i = 0 To mesTD.Length - 1
            'gauche et droite en cas de fusion sur plusieurs lignes
            If Range(mesTD(i).ID).Rows.Count > 1 And Range(mesTD(i).ID).Column > PLAGE.Column Then
                B = True
                Set rangeleft = Range(mesTD(i).ID).Offset(0, -1).Resize(Range(mesTD(i).ID).Rows.Count, 1)
                For RL = 2 To rangeleft.Cells.Count
                    If rangeleft.Cells(RL).Borders(xlEdgeRight).LineStyle <> rangeleft.Cells(RL - 1).Borders(xlEdgeRight).LineStyle Then B = False
                Next
                If B = True Then
                    For Each cel In rangeleft.Cells
                        .getelementbyid(cel.MergeArea.Address).Style.borderright = 0
                    Next
                Else
                    mesTD(i).Style.borderleft = 0
                End If
            End If
            'top et basse en cas de fusion sur plusieurs colonne
            If Range(mesTD(i).ID).Columns.Count > 1 And Range(mesTD(i).ID).Column >= PLAGE.Column Then
                B = True
                Set rangeBOTTOM = Range(mesTD(i).ID).Offset(1, 0).Resize(1, Range(mesTD(i).ID).Columns.Count)
                Set rangeTOP = Range(mesTD(i).ID).Offset(-1, 0).Resize(1, Range(mesTD(i).ID).Columns.Count)
                For RL = 2 To rangeBOTTOM.Cells.Count
                    If rangeBOTTOM.Cells(RL).Borders(xlEdgeTop).LineStyle <> rangeBOTTOM.Cells(RL - 1).Borders(xlEdgeTop).LineStyle Then B = False
                Next
                If B = True Then
                    For Each cel In rangeleft.Cells: .getelementbyid(cel.MergeArea.Address).Style.bordertop = 0: Next
                Else
                    mesTD(i).Style.borderbottom = 0
                End If
 
                For RL = 2 To rangeTOP.Cells.Count
                    If rangeTOP.Cells(RL).Borders(xlEdgeBottom).LineStyle <> rangeTOP.Cells(RL - 1).Borders(xlEdgeBottom).LineStyle Then B = False
                Next
                If B = True Then
                    For Each cel In rangeleft.Cells: .getelementbyid(cel.MergeArea.Address).Style.borderbottom = 0: Next
                Else
                    mesTD(i).Style.bordertop = 0
                End If
            End If
        Next
        For i = 0 To mesTD.Length - 1
            If mesTD(i).colspan = 1 And mesTD(i).rowspan = 1 And Range(mesTD(i).ID).Row > PLAGE.Row Then
                Set R = Range(mesTD(i).ID).Offset(-1, 0).MergeArea
 
                If .getelementbyid(R.Address).Style.borderbottom = mesTD(i).Style.bordertop Then mesTD(i).Style.bordertop = 0
            End If
        Next
        For i = 0 To mesTD.Length - 1
            If mesTD(i).colspan = 1 And mesTD(i).rowspan = 1 And Range(mesTD(i).ID).Column > PLAGE.Column Then
                Set R = Range(mesTD(i).ID).Offset(0, -1).MergeArea
                Debug.Print R.Address
                If .getelementbyid(R.Address).Style.borderright = mesTD(i).Style.borderleft Then mesTD(i).Style.borderleft = 0
            End If
        Next
        'Debug.Print .body.innerhtml
        range_to_html_DOM3 = .body.innerhtml
    End With
 
End Function
Function text_formaté(cel)
    Dim F, Doc, L, formt, mot, forma, font, i As Long
    Set Doc = CreateObject("htmlfile")
    Doc.write "<br><div id=""mot""></div>"
    F = ""
    With Doc
        Set mot = .getelementbyid("mot")
        If IsDate(cel.Value) Then
            forma = cel.NumberFormat
            Set font = .createElement("FONT")
            font.innerhtml = IIf(cel.font.Italic, "<em>" & Format(cel.Value, forma) & "</em>", Format(cel.Value, forma))
            font.innerhtml = IIf(cel.font.Bold, "<strong>" & font.innerhtml & "</strong>", Format(cel.Value, forma))
            font.Color = coul_XL_to_coul_HTMLX(cel.font.Color): font.face = cel.font.Name: font.Size = Round(cel.font.Size / 3) & "px "
            text_formaté = font.outerhtml: Exit Function
        End If
        If IsNumeric(cel.Value) Then
            Set font = .createElement("FONT")
            font.innerhtml = IIf(cel.font.Italic, "<em>" & cel.Value & "</em>", cel.Value)
            font.innerhtml = IIf(cel.font.Bold, "<strong>" & font.innerhtml & "</strong>", cel.Value)
            font.Color = coul_XL_to_coul_HTMLX(cel.font.Color): font.face = cel.font.Name: font.Size = Round(cel.font.Size / 3) & "px "
            text_formaté = font.outerhtml: If cel.NumberFormat <> "@" Then Exit Function
        End If
        For i = 1 To Len(cel.Value)
            L = CStr(cel.Characters(Start:=i, Length:=1).Text)
            formt = "size=" & Round(cel.Characters(Start:=i, Length:=1).font.Size / 3) & "pt " & "face=""" & cel.Characters(Start:=i, Length:=1).font.Name & Chr(34) & " "
            formt = formt & "color=""" & coul_XL_to_coul_HTMLX(cel.Characters(Start:=i, Length:=1).font.Color) & Chr(34) & ">"
            If F <> formt Then
                Set font = .createElement("FONT"): F = formt
                font.Color = coul_XL_to_coul_HTMLX(cel.Characters(Start:=i, Length:=1).font.Color)
                font.face = cel.Characters(Start:=i, Length:=1).font.Name
                font.Size = Round(cel.Characters(Start:=i, Length:=1).font.Size / 3) & "px "
            End If
            If cel.Characters(Start:=i, Length:=1).font.Italic = True Then L = "<em>" & L & "</em>"
            If cel.Characters(Start:=i, Length:=1).font.Bold = True Then L = "<strong>" & L & "</strong>"
            font.innerhtml = font.innerhtml & L
            mot.appendchild (font)
        Next
        text_formaté = Replace(mot.innerhtml, "</STRONG><STRONG>", "")
        'Debug.Print Replace(mot.innerhtml, "</STRONG><STRONG>", "")
    End With
    Set Doc = Nothing
End Function
Function coul_XL_to_coul_HTMLX(couleur)
    Dim str0 As String, str As String
    'If couleur = 16777215 Then couleur = vbWhite
    str0 = Right("000000" & Hex(couleur), 6)
    str = Right(str0, 2) & Mid(str0, 3, 2) & Left(str0, 2)
    coul_XL_to_coul_HTMLX = "#" & str & ""
End Function
Function borderstyle(Cote)
    Dim borderweight, bstyle As String, bcolor As String
    If Cote.LineStyle = xlNone Then borderstyle = "0.1pt solid #CED8F6": GoTo fin
    borderweight = Switch(Cote.Weight = 1, 1, Cote.Weight = 2, 1, Cote.Weight = -4138, 2, Cote.Weight = 4, 3) & "px  "
    bstyle = IIf(Cote.LineStyle <> 1, "dashed", "solid")    'xlDouble
    If Cote.LineStyle = xlDash And Cote.Weight = xlThick Then borderweight = 3 & "px  "   ' xldash et epaisseur xlthick   'Tiret en pointillet
    If Cote.LineStyle = xlDash And Cote.Weight = xlThin Then borderweight = 2 & "px  ":: bstyle = "dotted"     'point  en pointillet
    If Cote.LineStyle = xlDashDotDot Then bstyle = " dashed": borderweight = 3 & "px  "  'xlDashDotDot
    If Cote.LineStyle = xlDouble Then bstyle = " double": borderweight = 3 & "px  "
    bcolor = coul_XL_to_coul_HTMLX(Cote.Color)
    borderstyle = borderweight & bstyle & "  " & bcolor
fin:
End Function

maintenant la démo

Nom : demo2.gif
Affichages : 1100
Taille : 943,9 Ko

**Menhir** · 09/02/2017, 09h02

Envoyé par patricktoulon

aucune des fonctions ou procédures natives de vba a excel y compris sendmail ne te rendra la mise en formea 100%

Bin si, celle que j'ai indiqué : un Range.CopyPicture, c'est-à-dire faire une copie "image" de la zone.

Là, tu es sûr que ton correspondant verra exactement ce que tu souhaites. Pas de soucis de polices de caractères, de version d'Excel ou de fichier lié. C'est du bronze.
Il y a aussi la solution de faire un PDF mais c'est moins sûr, en particulier à cause de la découpe en pages et parce que Excel est loin d'être WYSIWYG.

Le revers de la médaille, c'est que les données sont difficilement récupérables pour un usage postérieur (mais dans certains cas, ça peut être un avantage).

**patricktoulon** · 09/02/2017, 09h13

re
Bonjour menhir
oui envoyer une capture est une solution mais pour l'exploitation c'est walouh!!!!!!
le destinataire si il en a besoin est obligé de tout recopier a la main hihihihihih
je faisait comme ca il y a 12 ans

perso quand on me demande comment mettre une plage de cellule dans le corps d'un mail je réponds a la question je donne pas une pseudo astuce qui certes a un effet visuel qui donne l'impression mais ce n'est pas une plage qui est envoyé c'est une image
et même la pour mettre l'image dans le corps du mail selon la méthode employée ,c'est pas gagné, perso j'utilise CDO et ca marche très bien
voila voila

**RyuAutodidacte** · 09/02/2017, 09h32

Bonjour,

Suggestion :
Je m'y connais pas en mail via Excel, mais une solution toute simple serait (en macro) de créer un nouveau classeur avec la plage à envoyer et joindre ce nouveau classeur au mail pour envoie.
On aura donc les données si elles ont besoin d'être traitées.

**patricktoulon** · 09/02/2017, 09h42

re
Bonjour Ryu
oui c'est une solution envoyé l'image dans le corps et le classeur en PJ mais ca représente un UPLOAD sur le serveur de messagerie
et selon le serveur des fois ca plombe l'application Excel tant que l'upload n'est pas effectué a 100%
alors qu'avec ma méthode il n'y a pas de upload la table fait partie du corps du message en HTML bien sur
d'ailleurs même avec CDO que j'utilise avec une image dans le corps du mail il y a l'upload de l'image et même avec tout autre méthode d'ailleurs

voila voila

**Menhir** · 09/02/2017, 09h56

Envoyé par patricktoulon

oui envoyer une capture est une solution mais pour l'exploitation c'est walouh!!!!!!
le destinataire si il en a besoin est obligé de tout recopier a la main hihihihihih

C'est ce que j'ai indiqué dans mon message.
C'est une solution qui a l'avantage d'être très simple à mettre en place et de marcher dans tous les cas.
Pour savoir comment transformer une CopyPicture en fichier image : https://excel.developpez.com/faq/?pa...ePlageCellules

Le fait d'entraver la recopie des données pour le destinataire (quoi qu'avec un bon OCR...) n'est pas forcément gênant suivant l'usage souhaité. Ca peut même être un avantage (ce n'est pas pour rien qu'on envoie parfois des PDF protégés plutôt que des fichiers originaux).
La demande originale de ce sujet était

A chaque fin de mois je dois envoyer la sélection de cellules à chaque client. Jusqu'à présent je les imprimais mais j'aimerai mieux les envoyer par mail.

Si c'est juste de remplacer un envoie papier par un envoie mail, l'image peut convenir.
La création de PDF aussi d'ailleurs.

L'avantage de cette méthode est qu'elle inclut TOUT et de manière totalement SURE.
Par exemple, contrairement à ta méthode, elle inclut les images, les formes, les graphes, les sparkline, les MFC, les graphes de MFC, les équations, etc.

Il n'y a pas de méthode idéale et parfaite.
Chaque méthode a son intérêt en fonction de l'application souhaitée.

**patricktoulon** · 09/02/2017, 10h14

RE
Oui Menhir
j'envoie une 50aine de massage par jour avec excel si je devais uploader a chaque fois les images je ne m'en sort plus pour la table html c'est pareil si le destinataire ne sais pas comment il faut faire pour la récupérer c'est walouh

comme OCR j'utilise abyfinereader je récupère pratiquement tout texte avec et il est pas tout jeune

perso je pense a l'upload qui avec VBA est bloquant que se soit CDO,outlook,tune,etc......

mais l'image reste une solution facile a mettre a place pour les débutants c'est vrai perso j'utilise le html et quelques astuce CSS (dans une balise style a l'intérieur du body) et html notamment le onwindow et même le Mime qui me permet quand même de retarder le destinataire indélicat de modifier le contenu
je te garanti que si la personne n'a pas les connaissances suffisante si il essaie de copier ma table html même a la main sur un fichier texte avec extension html il aura des surprises h

ihihihihihihi

voila voila

**Menhir** · 09/02/2017, 10h29

Envoyé par patricktoulon

j'envoie une 50aine de massage par jour avec excel si je devais uploader a chaque fois les images je ne m'en sort plus pour la table html c'est pareil si le destinataire ne sais pas comment il faut faire pour la récupérer c'est walouh

Comme je le disais, ça dépend de l'usage qu'en fait la personne.
Je ne doute pas que la méthode que tu décris soit la plus adaptée à ton usage.

Mais d'autres solutions peuvent être proposées au demandeur qui jugera de celle qui convient le mieux à son propre usage.

Personnellement, je privilégie le passage par PDF.
Mais c'est un poil plus compliqué que de faire une image.

**unparia** · 09/02/2017, 11h14

Bonjour
Il suffit de relire le premier message du demandeur, et notamment ce passage :

A chaque fin de mois je dois envoyer la sélection de cellules à chaque client. Jusqu'à présent je les imprimais mais j'aimerai mieux les envoyer par mail

pour se rendre compte :
- de ce que le destinataire n'a pas à utiliser les données et qu'il reçoit simplement un simple document informatif (en remplacement d'une enveloppe dans laquelle se trouverait une feuille imprimée) ...
- et donc de ce que la solution image proposée par Menhir (à qui je mets un

pour sa lecture attentive et sa perspicacité) est celle qui convient parfaitement.

EDIT : j'observe surtout que lorsque l'on envoie un document informatif à un client, on n'a pas à le rendre dépendant, pour qu'il puisse prendre connaissance de son contenu, de TEL ou TEL autre logiciel particulier.
On lui envoie un document dans un format tel qu'il lui est possible de l'afficher avec le/les outil(s) de SON choix parmi celui/ceux qu'il possède à coup certain (parce que présent(s) nativement sur toute machine, quel qu'en soit l'OS). Il serait bien présomptueux de lui imposer d'autres installations pour prendre connaissance d'un document.
Je me rappelle à ce propos ne m'être volontairement pas rendu à une réunion internationale à laquelle une fonctionnaire avait convié des participants (dont moi-même) en leur faisant parvenir par mail un document qui n'était consultable qu'à condition de posséder le logiciel qu'elle avait utilisé pour le rédiger, estimant avec assez de suffisance que chacun se devait de posséder le même logiciel de lecture ! On n'a pas à faire cela !!!!

**Marquisette65** · 09/02/2017, 12h48

Merci Patrick et Menhir pour l'intérêt que vous portez à mon problème et en lisant vos posts je me rend compte que vos connaissances sont "légèrement" supérieures aux miennes! sincèrement vous me parlez chinois!!!

alors j'ai essayé vos deux macros, comme ça pas de jaloux!
car effectivement moi je m'en fiche que ce soit une image ou pas, que ce soit dans le corps du message ou en pièce jointe... j'aimerai juste que chaque fin de mois je puisse envoyer mes 15 tableaux à mes 15 destinataires!

alors Menhir :
je ne doute pas que ta solution soit simple et évidente pour certaine mais sincèrement pas pour moi.
j'ai bien changé le serveur, mis les adresses mails de l'expéditeur et du destinataire mais je ne sais pas ce qu'est le "tu n'a juste qu'a compléter le manque UsedRange par la plage de cellules que tu veux envoyer".

Patrick:
j'ai également essayé et là j'ai un message du type "erreur d'exécution 1004 Impossible de lire la propriété Text de la classe Characters."

désolée mais je suis vraiment débutante et soyons francs, là ça dépasse mes capacités ! Ce n'est pas bien grave, je pensais que c'était plus simple que ça, je vais continuer à imprimer, le papier c'est bien aussi, c'est plus chaleureux :p

Merci quand même !

Invité · 09/02/2017, 12h52

Bonjour,

Merci Patrick et Menhir pour l'intérêt que vous portez à mon problème et en lisant vos posts je me rend compte que vos connaissances sont "légèrement" supérieures aux miennes!

quel chance tu as;en ce qui me concerne elles sont nettement supérieur!

mais si tu veux t'affranchir du papier et de la corvée de l'impression fais un PDF!

la méthode de Patrick demande d'utiliser un enchaînement de fonction et même pas si ça ce trouve (prête à l'emploi)! mais juste de l'utiliser (en modifiant les paramètres à transmette) comme le code que je t'avais soumis!

code = range_to_html_DOM3(PLAGE, True)

**Marquisette65** · 09/02/2017, 13h04

oui je suis bien d'accord avec toi mais sincèrement je n'arrive pas à le faire fonctionner ton code!

à chaque fois il beug sur ".send", donc je n'ai pas du modifier correctement la sub test.

Problème de Macro VBA pour envoyer un tableau avec sa mise en forme [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager