envoie mail avec background dans corps de message depuis excel

ccharvet1

XLDnaute Nouveau
Bonjour,

Je souhaite envoyer des mail depuis excel mais avec un fond et aussi ajouter des images à côté du téléphone, portable, etc.. (pièce jointe)
L'envoi de mail, c'est bon mais c'est l'ajout du background et images qui bloquent.
Voici une partie
Code:
Private Sub CommandButton44_Click() 'envoi email
Dim NomFichier As String
Dim TypeDoc As String
Dim AbreTypeDoc As String
Dim Numdoc As String
Dim DateDoc As String
Dim HreDoc As String
Dim NomCli As String
Dim TelEnt As String
Dim PortEnt As String
Dim MailCli As String
Dim MailEnt As String
Dim AdressEnt As String
Dim VilleEnt As String
Dim MontantTTC As String
Dim objMessage As Object
Dim messageHTML As String
Dim sNomPdf As String
Dim sDossier As String
Dim sNomCrypt As String
  
    sDossier = ThisWorkbook.Path

    TypeDoc = Worksheets("Document").Range("F25").Value
    AbreTypeDoc = Worksheets("Document").Range("G26").Value
    Numdoc = Worksheets("Document").Range("H26").Value
    DateDoc = Worksheets("Document").Range("G27")
    NomCli = Worksheets("Document").Range("F31").Value
    TelEnt = Worksheets("Document").Range("B32").Value
    PortEnt = Worksheets("Document").Range("B33").Value
    MailEnt = Worksheets("Document").Range("O36").Value
    AdressEnt = Worksheets("Document").Range("B30").Value
    VilleEnt = Worksheets("Document").Range("B31").Value
    MailCli = Worksheets("Document").Range("F35").Value
    MontantTTC = Worksheets("Document").Range("N45").Value
    NomFichier = AbreTypeDoc & " " & Numdoc & " du " & DateDoc

    On Error GoTo errorHandler
    sNomPdf = sDossier & "\" & NomFichier & ".pdf"
 
    Worksheets("Document").ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=sNomPdf, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
 
    sNomCrypt = sDossier & "\" & "Tempo.pdf"
    EncryptPDFUsingPdfforgeDll sNomPdf, sNomCrypt
 
    Kill sNomPdf
    Name sNomCrypt As sNomPdf
 
    Set objMessage = CreateObject("CDO.Message")
    objMessage.Subject = "votre " & TypeDoc & " n° " & AbreTypeDoc & " " & Numdoc & " du " & DateDoc
    objMessage.From = MailEnt
    objMessage.To = MailCli
    
If Feuil4.Cells(25, 6) = "Facture" Then
 objMessage.TextBody = "Bonjour," & vbCrLf & vbCrLf & "Veuillez trouver ci-joint la copie de la facture acquittee..." & vbCrLf & vbCrLf & "Sinceres salutations." & vbCrLf & vbCrLf & "H. DUPONT" & vbCrLf & TelEnt & vbCrLf & PortEnt
ElseIf Feuil4.Cells(25, 6) = "Facture à régler" Then
 objMessage.TextBody = "Bonjour," & vbCrLf & vbCrLf & "Veuillez trouver ci-joint la copie de la facture non acquittee..." & vbCrLf & vbCrLf & "Sinceres salutations." & vbCrLf & vbCrLf & "H. DUPONT" & vbCrLf & TelEnt & vbCrLf & PortEnt
'ElseIf Feuil4.Cells(25, 6) = "Avoir" Then
' objMessage.TextBody = "Bonjour," & vbCrLf & vbCrLf & "Veuillez trouver ci-joint votre avoir ... & vbCrLf & vbCrLf & "Sinceres salutations." & vbCrLf & vbCrLf & "H. DUPONT" & vbCrLf & TelEnt & vbCrLf & PortEnt
End If
    messageHTML = "Ceci est un message en HTML"
 
    objMessage.Configuration.Fields.Item _
            ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    objMessage.Configuration.Fields.Item _
            ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.bbox.fr"
    objMessage.Configuration.Fields.Item _
            ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    objMessage.Configuration.Fields.Update
 
    objMessage.AddAttachment sNomPdf
    objMessage.Send
    objMessage.MDNRequested = True
 
    Set objMessage = Nothing
       UserForm5.Show
    Exit Sub
 
errorHandler:
    MsgBox Err.Description
End Sub

Private Sub EncryptPDFUsingPdfforgeDll(sNomFichier As String, sOutputCrypt As String)
Dim Pdf As Object, Crypt As Object
 
    Set Crypt = CreateObject("pdfforge.pdf.PDFEncryptor")
 
    With Crypt
        .AllowAssembly = False
        .AllowCopy = False
        .AllowFillIn = False
        .AllowModifyAnnotations = False
        .AllowModifyContents = False
        .AllowPrinting = True
        .AllowPrintingHighResolution = True
        .AllowScreenReaders = False
        .EncryptionMethod = 2
 
        .OwnerPassword = "master"
        .UserPassword = ""
    End With
 
    Set Pdf = CreateObject("pdfforge.pdf.pdf")
    Pdf.EncryptPDFFile sNomFichier, sOutputCrypt, Crypt
 
    Set Pdf = Nothing
    Set Crypt = Nothing
End Sub
Avez-vous une idée sur la manière dont il faut procéder ?

Y-a le html mais je ne connais pas et après quoi faire avec vous le diriez peux-etre ?

Coridalement
 

Pièces jointes

  • exemple-corps-message-email.jpg
    exemple-corps-message-email.jpg
    26 KB · Affichages: 153

Discussions similaires

Statistiques des forums

Discussions
311 733
Messages
2 082 015
Membres
101 867
dernier inscrit
XFPRO