Sub EnvoiMailConso()

Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object

Set rng = Nothing

' tableau variations
With Sheets("BDL retraité")

    Set rng = .Range("D1:M8")

End With

rng.CopyPicture

If rng Is Nothing Then
    MsgBox "The selection is not a range or the sheet is protected. " & _
           vbNewLine & "Please correct and try again.", vbOKOnly
    Exit Sub
End If

With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


With OutMail
    .To = "christophe.marle@savilecapital.lu"
    .CC = "pe.pourrat@savilecapital.lu;jacques.bossuyt@savilecapital.lu"
    .BCC = "christian.mouisel@savilecapital.lu"
    ' SUJET DU MAIL, MODIFIER LA DATE DANS Range("E9")
    .Subject = "SOI au " & Sheets("BDL retraité").Range("E9")
'    .HTMLBody = RangetoHTML(rng)
    ' In place of the following statement, you can use ".Display" to
    ' display the e-mail message.
    .Display
End With
On Error GoTo 0

'Get its Word editor
Dim wordDoc As Word.Document
Set wordDoc = OutMail.GetInspector.WordEditor

'Colle tableau variations
wordDoc.Range.PasteAndFormat wdChartPicture
wordDoc.Range.InsertParagraphAfter

'Graphique Allocations
Sheets("BDL retraité").ChartObjects("Graphique 7").Copy
With wordDoc.Range(wordDoc.Characters.Count - 1, wordDoc.Characters.Count)
    .InsertAfter Chr(11) & Chr(11)
End With
wordDoc.Range(wordDoc.Characters.Count - 1, wordDoc.Characters.Count).PasteAndFormat wdChartPicture

'Graphique Devises
Sheets("BDL retraité").ChartObjects("Graphique 6").Copy
With wordDoc.Range(wordDoc.Characters.Count - 1, wordDoc.Characters.Count)
    .InsertAfter Chr(11) & Chr(11)
End With
wordDoc.Range(wordDoc.Characters.Count - 1, wordDoc.Characters.Count).PasteAndFormat wdChartPicture

'Graphique Contribution par masses
Sheets("BDL retraité").Range("D77:F86").Copy
With wordDoc.Range(wordDoc.Characters.Count - 1, wordDoc.Characters.Count)
    .InsertAfter Chr(11) & Chr(11)
End With
wordDoc.Range(wordDoc.Characters.Count - 1, wordDoc.Characters.Count).PasteAndFormat wdChartPicture


With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing
End Sub