Adding a signature or image after body of text ??

[JamesStag]

Hi if some one could please help me add a signature or image to this code i would be very grateful.

Sub twosaves()

 Sheets("Quote").Select
 ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        filename:="C:\Users\James\Documents\Excel Test Folder\Quotes PDFs Test\" & _
        Worksheets("Details").Range("C11").Value & ".pdf", _
        OpenAfterPublish:=False
        
    Worksheets("Details").Select
        Range("C11").Select
        ActiveCell.Value = ActiveCell.Value + 1
            
    Sheet1.SaveAs "C:\Users\James\Documents\Excel Test Folder\" & _
        "Quotes Invoices Spread Sheets\" & _
        Worksheets("Details").Range("C27").Value & ".xlsm", _
        xlOpenXMLWorkbookMacroEnabled
         Dim strPath As String, strFName As String, Signature As String
   
   

   'Create the PDF
    Worksheets("Quote").ExportAsFixedFormat Type:=xlTypePDF, filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
    :=False, OpenAfterPublish:=False
   

 'Create PDF of active sheet only
    strPath = Environ$("temp") & "\" 'Or any other path, but include trailing "\"
   
    strFName = ActiveWorkbook.Name
    strFName = Left(strFName, InStrRev(strFName, ".") - 1) & "_" & ActiveSheet.Name & ".pdf"
   
    Worksheets("Quote").ExportAsFixedFormat Type:=xlTypePDF, filename:= _
        strPath & strFName, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
   
   ' Select the range of cells on the active worksheet.
    
   
   ' Show the envelope on the ActiveWorkbook.
   ActiveWorkbook.EnvelopeVisible = True
  
   ' Set the optional introduction field thats adds
   ' some header text to the email body. It also sets
   ' the To and Subject lines. Finally the message
   ' is sent.
   On Error Resume Next
   With ActiveSheet.MailEnvelope
      .Item.To = Range("C8").Value
      .Item.Subject = "Stag Arborists"
      .Item.Body = Worksheets("sheet1").Select.Range("B2").Value
      .Item.Attachments.Add strPath & strFName
      .Item.send
   End With
End Sub

 

[MARK858]

Duplicate of This Post