VBA - signature mail - pbm affichage logo

Bonjour à tous,

Je suis confronté à un problème d'affichage du logo ou image dans ma signature de mail.

En effet, je souhaite générer un mail à partir de l'excel joint.

Problématique, lorsque je génère le mail suivant et que je commente ou non cette ligne :

.HTMLBody = RangetoHTML(Range("B10:C20")) & Signature

- si je la commente, ma signature préalablement préparée dans outlook s'affiche intégralement avec le logo mais je ne vois pas le corps de mon mail généré.

- si je ne la commente pas, mon mail est généré et s'affiche, ma signature aussi mais le logo ne s'affiche pas. j'ai le message suivant "nous ne pouvons pas afficher l'image"

J'ai beau regardé sur Google les spécificités mais je ne trouve pas de solution pour remédier à mon problème.

C'est pourquoi je sollicite votre aide et vous remercie par avance pour l'attention que vous porterez à mon dilemme.

Bonjour guibs,

Punaise vous aimez les lignes vides

De plus, ça fait longtemps que je n'utilise plus la méthode du "GetBoiler"

Voici ce dont vous avez besoin (c'est une possibilité)

Sub Envoi_SPA()
  ' Envoi_SPA_ Macro
  Dim OutlookApp As Object
  Dim MailItem As Object
  Dim SigString As String
  Dim Signature As String
  Application.ScreenUpdating = False
  ' Vérifier si Outlook est ouvert
  On Error Resume Next
  Set OutlookApp = GetObject(, "Outlook.Application")
  On Error GoTo 0
  ' Si Outlook n'est pas ouvert, ouvrir une nouvelle instance
  If OutlookApp Is Nothing Then
    Set OutlookApp = CreateObject("Outlook.Application")
  End If
  ' Créer un nouvel e-mail
  Set MailItem = OutlookApp.CreateItem(0)
  ' Remplir les détails de l'e-mail
  With MailItem
    .Display
    .To = Range("B4")
    .Subject = Range("B8")
    .HTMLBody = RangetoHTML(Range("B10:C20")) & .HTMLBody
    ' Ajouter des pièces jointes si nécessaire
    ' .Attachments.Add "chemin_de_la_piece_jointe"
  End With
  ' Libérer les objets
  Set MailItem = Nothing
  Set OutlookApp = Nothing
  'Application.WindowState = xlNormal
  ActiveWindow.SmallScroll Down:=0
  ActiveWorkbook.Save
End Sub

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

A+

Bonjour,

Merci pour votre retour. De mon côté, j'avais continué a chercher et je me suis rendu compte effectivement d'un mauvais positionnement du ". Display" et d'un oubli du ".HTMLbody"

Je vais nettoyer aussi en enlevant le Getboiler et tester. Mais en principe avec les éléments cités plus haut ca fonctionne déjà.

En tout cas merci d'avoir consacré votre temps dans la résolution du problème c'est très gentil.