Excel 2010 Coller Gamme et les images dans Outlook

Je vais avoir de la difficulté considérable à comprendre ça. Je peux coller une plage en HTML sans problèmes, mais dans certaines communications, nous voulons passé la gamme comme une image à la place. Je peux créer une gamme et l'enregistrer comme une image, mais je ne peux pas comprendre comment le passé de l'image dans Outlook après sa création.

Si vous êtes simplement à la recherche d'un code qui permettra de copier une gamme et de le coller dans Outlook, cela fonctionne très bien. Toutes les données d'email est de référencement de cellules sur un onglet appelé la poste, de sorte que vous pouvez simplement copier et coller l'onglet Courrier et de la macro dans un classeur et ajouter de l'e-mail de l'automatisation en modifiant les champs dans l'onglet courrier et de ne pas modifier la macro. Si vous utilisez ce code, assurez-vous de référence de Microsoft Outlook.x.x Object Library (En VBA Fenêtre: Outils - Références - Microsoft Outlook x.x Object Library).

J'ai besoin de prendre un peu plus loin et être en mesure de tourner la gamme dans une image et la coller dans le message. Je peux le joindre, mais je ne peux pas l'insérer dans le corps, qui est ce dont j'ai besoin. J'ai regardé plusieurs exemples, y compris ceux sur Ron DeBruins site web, mais je n'ai pas été en mesure d'obtenir l'un d'eux pour travailler. Je suis sous Windows 7 x64 Avec Office 2010 64 bits.

Voici le code, je suis en cours d'exécution à coller une plage.

Option Explicit
Sub Mail_AS_Range()
' Working in Office 2010-2013
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim strbody As String
On Error Resume Next
Dim sh As Worksheet
Set sh = Sheets("Mail")
strbody = sh.Range("C9").Value
Sheets(sh.Range("C11").Value).Select
ActiveWorkbook.Save
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.SentOnBehalfOfName = sh.Range("C4")  'This allows us to send from an alternate email address
.Display  'Alternate send address will not work if we do not display the email first.
'I dont know why but this step is a MUST
.To = sh.Range("C5")
.CC = sh.Range("C6")
.BCC = sh.Range("C7")
.Subject = sh.Range("C8").Value
.HTMLBody = "<br>" & strbody & fncRangeToHtml(sh.Range("C13").Value, sh.Range("C14").Value) & .HTMLBody
' This is where the body of the email is pulled together.
' <br> is an HTML tag to turn the text into HTML
' strbody is your text from cell C9 on the mail tab
' fncRangetoHtml is converting the range you specified into HTML
' .HTMLBody inserts your email signature
.Attachments.Add sh.Range("C10").Value
'.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Private Function fncRangeToHtml( _
strWorksheetName As String, _
strRangeAddress As String) As String
' This is creating a private function to make the range specified in the Mail macro into HTML
Dim objFilesytem As Object, objTextstream As Object, objShape As Shape
Dim strFilename As String, strTempText As String
Dim blnRangeContainsShapes As Boolean
strFilename = Environ$("temp") & "\" & _
Format(Now, "dd-mm-yy_h-mm-ss") & ".htm"
ThisWorkbook.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=strFilename, _
Sheet:=strWorksheetName, _
Source:=strRangeAddress, _
HtmlType:=xlHtmlStatic).Publish True
Set objFilesytem = CreateObject("Scripting.FileSystemObject")
Set objTextstream = objFilesytem.GetFile(strFilename).OpenAsTextStream(1, -2)
strTempText = objTextstream.ReadAll
objTextstream.Close
strTempText = Replace(strTempText, "align=center x:publishsource=", "align=left x:publishsource=")
For Each objShape In Worksheets(strWorksheetName).Shapes
If Not Intersect(objShape.TopLeftCell, Worksheets( _
strWorksheetName).Range(strRangeAddress)) Is Nothing Then
blnRangeContainsShapes = True
Exit For
End If
Next
If blnRangeContainsShapes Then strTempText = fncConvertPictureToMail(strTempText, Worksheets(strWorksheetName))
fncRangeToHtml = strTempText
Set objTextstream = Nothing
Set objFilesytem = Nothing
Kill strFilename
End Function
Public Function fncConvertPictureToMail(strTempText As String, objWorksheet As Worksheet) As String
Const HTM_START = "<link rel=File-List href="
Const HTM_END = "/filelist.xml"
Dim strTemp As String
Dim lngPathLeft As Long
lngPathLeft = InStr(1, strTempText, HTM_START)
strTemp = Mid$(strTempText, lngPathLeft, InStr(lngPathLeft, strTempText, ">") - lngPathLeft)
strTemp = Replace(strTemp, HTM_START & Chr$(34), "")
strTemp = Replace(strTemp, HTM_END & Chr$(34), "")
strTemp = strTemp & "/"
strTempText = Replace(strTempText, strTemp, Environ$("temp") & "\" & strTemp)
fncConvertPictureToMail = strTempText
End Function

Toutes les suggestions seraient appréciées. Merci!

  • Avez-vous vérifié cela? vba-useful.blogspot.com/2014/01/...
  • Il aura besoin d'un peu d'adaptation mais c'est aller au travail, même mieux que ce que j'attendais! Je vais poster la version révisée du code qui fonctionne dans mon projet. MERCI!!!!