XL 2016 Envoi mail Outlook plage de cellule (qui ne se déforme pas)

Dim MailItem    As Object
Dim Outlook     As Object
Dim Wins        As Object

Sub Exemple()
    On Error Resume Next
    Ow = Outlook.ActiveWindow.WindowState ' Test si Outlook est ouvert
    If Err Then
        Err.Clear
        Set Outlook = CreateObject("Outlook.Application")
            Set MailItem = Outlook.CreateItem(olMailItem)
                MailItem.Display
            Set Wins = MailItem.GetInspector.wordeditor
    End If
    If Err = 0 Then
       [A1:E14].CopyPicture
        Wins.Paragraphs(1).Range.Paste
        MailItem.Display
    Else
        MsgBox "Erreur " & Err.Number & " - " & Err.Description & vbLf & _
            "Recommencez ...", vbCritical + vbOKOnly
    End If
End Sub

Option Explicit
Dim MailItem As Object
Dim Outlook As Object

Sub MAIL()
Dim Signature As String, L As Variant, Ow
    Signature = "Signature1" ' Nom d'une signature établie dans Outlook
    L = InputBox("Nombre de lignes à insérer", , 115)
    
    On Error Resume Next
    Ow = Outlook.ActiveWindow.WindowState ' Test si session Outlook ouverte
    If Err Then
        Err.Clear
        Set Outlook = CreateObject("Outlook.Application")
        Set MailItem = Outlook.CreateItem(0)
    End If
    If Err = 0 Then
        On Error GoTo 0
        With MailItem
            .display
            .To = "XXXXXX@AAA.fr"
            .Subject = "P1"     ' Objet de l'e-mail
            If Signature = "" Then
                Signature = .HTMLBody ' Signature par défaut si paramètré dans outlook
            Else
               Signature = GetSig(Signature) ' Récupération de la signature si elle existe
            End If
            .HTMLBody = "Bonjour,<br><br>" & _
            "Voici les données pour le mois<br><br>" & _
            RangetoHTML(Sheets("Préparation Mail").[A1:G1].Resize(L)) & _
            "<br><br>" & _
            Signature

        ' .display
        End With
        Set Outlook = Nothing
    Else
        MsgBox "Erreur " & Err.Number & " - " & Err.Description & vbLf & _
        "Recommencez ...", vbCritical + vbOKOnly
    End If
End Sub
Function GetSig(ByVal Signature As String) As String
Dim Fso As Object
Dim Txs As Object
Dim File As String
    Set Fso = CreateObject("Scripting.FileSystemObject")
         File = Environ("appdata") & "\Microsoft\Signatures\" & Signature & ".htm"
        'File = "C:\Utilisateurs\XXXXXX\AppData\Roaming\Microsoft\Signatures\" & Signature1 & ".htm"
        Select Case True
            Case Signature = "":
            Case Not Fso.FileExists(File):
            Case Else
                Set Txs = Fso.GetFile(File).OpenAsTextStream(1, -2)
                GetSig = Txs.readall
                Txs.Close
                Set Txs = Nothing
        End Select
    Set Fso = Nothing
End Function
Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
    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 xlPasteColumnWidths, , False, False
        .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