Envoi de plusieurs fichiers par mail via une macro

**patricktoulon** · 14/12/2015, 11h45

Bonjour a tout les deux

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

vous avez l'appercu directement dans IE

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
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

**Oliv-** · 23/12/2015, 17h50

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

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 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

**patricktoulon** · 23/12/2015, 19h54

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

**patricktoulon** · 23/12/2015, 22h37

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 :

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

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 :

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

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
Nom : Capture.JPG
Affichages : 4215
Taille : 168,0 Ko

c'est bloffant non??

**GLDRX** · 19/06/2019, 17h53

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 :

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

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

Envoi de plusieurs fichiers par mail via une macro

Macros et VBA Excel

Discussions similaires

Partager

Partager