Envoi de plusieurs fichiers par mail via une macro

Version imprimable

Voir 40 message(s) de cette discussion en une page

Bonjour a tout les deux

voici un exemple ultra simplifié!!!! de mon module

vous avez l'appercu directement dans IE

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
Sub Test()
    HTML = "<Html><Head></Head><Body>[InertTableau]</Body></Html>"
    HTML = Replace(HTML, "[InertTableau]", RetournTable(ActiveSheet.Range("A1").CurrentRegion))
    'APPERCU DANS INTERNET EXPLORER
    Set IE = CreateObject("internetexplorer.application")
    IE.navigate "abou:blanks"
    IE.Visible = True
    IE.document.write HTML
    Set IE = Nothing
End Sub
Function RetournTable(R As Range) As String
    Dim L As Integer, C As Integer, Styl As String, elem As Object
    For L = 1 To R.Rows.Count
        code = code & "<tr id=ligne" & L & " > " & vbCrLf
        For C = 1 To R.Columns.Count
            code = code & "<td id=" & R(L, C).Address & ">" & R(L, C).Value & "</td>" & vbCrLf
        Next
        code = code & "</tr>" & vbCrLf
    Next
    With CreateObject("htmlfile")
        .write "<table>" & vbCrLf & code & "</table>"
        'ON VA STYLER LES CELLULES HTML IDENTIQUEMENT A CELLE DU SHEETS
        For Each elem In .all
            If elem.TAGNAME = "TABLE" Then
                elem.cellspacing = 0: elem.Style.Width = R.Width * (96 / 72): elem.Style.Height = R.Height * (96 / 72): elem.Style.bordercollapse = "collapse"
            End If
            If elem.TAGNAME = "TD" Then
                elem.Style.Border = "1px  solid " & coul_XL_to_coul_HTMLX(15853019)
                elem.Style.backgroundcolor = coul_XL_to_coul_HTMLX(Range(elem.ID).Interior.Color)
                elem.Style.Color = coul_XL_to_coul_HTMLX(Range(elem.ID).Font.Color)
                elem.Style.fontWeight = IIf(Range(elem.ID).Font.Bold, "bold", "")
                elem.Style.FontStyle = IIf(Range(elem.ID).Font.Italic, "italic", "")
                elem.Style.Width = Range(elem.ID).Width * (96 / 72)
                elem.Style.Height = Range(elem.ID).Height * (96 / 72)
            End If
        Next
        RetournTable = "<Div align='center'>" & .body.innerhtml & "</Div>"
    End With
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

Patrick,
sinon il y a cette méthode (qui n'est pas de moi d'ailleurs mais de Jean-François Corbett)

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
Sub ExceltoHTMLBODY()
Const olMailItem = 0
'Copy range of interest
Dim r As Range
Set r = Range("b10:G14")
r.Copy
 
'Open a new mail item
Dim outlookApp As Object
Set outlookApp = CreateObject("Outlook.Application")
Dim outMail As Object
Set outMail = outlookApp.CreateItem(olMailItem)
 
'Get its Word editor
outMail.Display
Dim wordDoc As Object
Set wordDoc = outMail.GetInspector.WordEditor
 
'To paste as picture
'wordDoc.Range.PasteAndFormat wdChartPicture
 
'To paste as a table
wordDoc.Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
 
End Sub

23/12/2015, 19h54
patricktoulon

re

bonsoir oliv

oui celui la je le connaissait pas mais je fait la meme chose avec outlook.com dans les contributions

copy/paste dans le body depuis j'en ai meme trouver une 3 eme dans un webbrowser avec un

<div contenteditable=true></div> ce qui m'evite de devoir utiliser une autre app que excel

mais je garde je la placerait avec celle de outlook.com

1 pièce(s) jointe(s)

allez je te montre comment on fait pareil sans outlokk ou autre application

re
re oliv et les autres aussi bien sur

voila comment j'arrive a coder le code html d'une table excel en html sans coder et sans outlook ou autre application externe

1 ajoute un userform dans ton projet "userform1"
2 met lui dedans un webbrowser" Webbrowser1"
3 met ce code dans le activate de l'userform
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Private Sub UserForm_Activate() With Me.WebBrowser1 .Navigate "about:blank" .Silent = True .Document.Write "<html><head></head><body><div id=""editeur"" contenteditable=""true"" ></div></body></html>" 'Do: DoEvents: Loop Until .ReadyState = 4 .Refresh .Document.getelementbyid("editeur").Focus SendKeys "{enter}" End With SendKeys "^v" End Sub
maintenant dans un module tu met
exemple
Code:

1 2 3 4 5 Sub copyplagehtml() Sheets(1).Range("b4:g14").Copy UserForm1.Show 0 End Sub
et voila tu a la meme chose que tu fait avec outlook
Résultat
Pièce jointe 196268

c'est bloffant non??;)

J'y suis presque

Bonjour à tous,

je relance un vieux poste car c'est exactement ce que je veux faire.

Merci à Patrick pour ça fonction RetournTable. Je l'ai implémenté dans mon code et cela fonctionne très bien.

Voilà ce que j'ai fait.
J'ouvre un fichier .msg dont je me sers comme modèle.
Je remplace un mot clé (ici "Tableau") par mon Range avec la fonction de Patrick.
Ensuite, j'affiche mon mail.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Dim myolapp As Object Dim MyItem As Object Set myolapp = CreateObject("Outlook.Application") Set MyItem = myolapp.CreateItemFromTemplate("C:\Temp\test.msg") MyItem.To = "toto@gmail.com" MyItem.Subject = "Nouveau mail" MyItem.HTMLBody = Replace(MyItem.HTMLBody, "Tableau", RetournTable(Sheets("Recap").Range("recapTab[#ALL]"))) MyItem.Display
Lorsque le mail s'affiche, je retrouve bien mon modèle test.msg avec mon range inséré au bon emplacement.

Par contre sur les premières ligne, je retrouve au format texte le contenu de mon tableau avec des élément de mise en forme.

Pouvez-vous m'expliquer pourquoi ?
Savez-vous comment ne pas afficher ces premières lignes et à défaut, pouvez-vous me dire comment les supprimer après coup ?

Je vous remercie par avance,
--
GLDRX

Voir 40 message(s) de cette discussion en une page