Funkt. rangetoHTML ist der Body mittigt
24.09.2021 14:51:24
Markus
über die Funktion Range to HTML pack ich einen Excel Bereich in eine Mail.
Leider ist dieses "Bild" immer nur Mittig und ich möchte es in der Mail linksbündig haben
Hier der entsprechende Code
Set objOutlook = CreateObject(Class:="Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
Set objWord = CreateObject("Word.Application")
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
objSignatureObject.NewMessageSignature = Signatur 'Name der gewünschten Signatur
objWord.Quit
With objMail
.GetInspector.Display
olOldbody = .htmlbody
.To = TO1
.cc = CC1
.Subject = Betreff
.htmlbody = fncRangeToHtml((reiter), Anfang & ":" & Ende) & olOldbody
Private Function fncRangeToHtml(strWorksheetName As String, strRangeAddress As String) As String
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
' For Each objShape In Worksheets(strWorksheetName).Picture
' 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 = "") - 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