Mailbody mit Bild aus Tabellenblatt?

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Mailbody mit Bild aus Tabellenblatt?
von: Kasimir
Geschrieben am: 27.09.2015 06:25:39

Hallo Leute!
Ich habe da mal eine Frage zum Erzeugen einer Outlookmail aus Excel heraus. Ich möchte in der Mail ein Bild mit einfügen. Das macht man ja über die Befehlszeile
.HTMLBody = "<img src=""Pfad\Bild.jpg"">"
Hier muss sich das Bild auf dem PC befinden. Geht das auch, wenn sich das Bild in der Exceldatei in einem Tabellenblatt befindet, also nach dem Prinzip
.HTMLBody = "<img src=""Tabellenblatt\Bildname"">"
,was sicherlich nicht richtig ist?
Wenn das gehen sollte, wie sieht dann die Befehlszeile aus?
Danke Euch schon mal im Voraus,
Kasimir

Bild

Betrifft: AW: Mailbody mit Bild aus Tabellenblatt?
von: Beverly
Geschrieben am: 27.09.2015 09:58:04
Hi Kasimir,
exportiere das Bild zuerst:

Sub BildExport()
    Dim chrDia As ChartObject
    Dim shaBild As Shape
    Application.ScreenUpdating = False
    Set shaBild = ActiveSheet.Shapes(1)
    shaBild.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    Set chrDia = ActiveSheet.ChartObjects.Add(0, 0, shaBild.Width, shaBild.Height)
    With chrDia.Chart
        ' erforderlich ab Excel2010, da Diagrammfläche automatisch mit Rahmen erstellt wird
        .Parent.ShapeRange.Line.Visible = msoFalse
        .Paste
        .Export Filename:="C:\Test\Bild.jpg", FilterName:="JPG"
    End With
    chrDia.Delete
    Set chrDia = Nothing
    Set shaBild = Nothing
    ' Kill "C:\Test\Bild.jpg"  '<== exporitertes Bild wieder löschen
    Application.ScreenUpdating = True
End Sub
Anschließend fügst du das Bild dann mit deinem Code in den HTML-Body ein.



Bild

Betrifft: AW: Mailbody mit Bild aus Tabellenblatt?
von: Kasimir
Geschrieben am: 27.09.2015 13:10:22
Hallo Karin!
Danke Dir für Deine Antwort. Es funktioniert super, hat aber einen kleinen Schönheitsfehler. Das Bild, das exportiert und in Outlook dann wieder importiert wird, hat an 2 Seiten einen Rahmen (siehe Bild).
Userbild
Ich habe mal meine Testdatei hochgeladen, in der man sieht, dass das Bild in der Tabelle keinen Rand hat.
https://www.herber.de/bbs/user/100425.xlsm
Hast Du oder jemand anderes, woran das mit dem Rahmen an den 2 Seiten liegen kann?
Danke nochmal und Gruß,
Kasimir

Bild

Betrifft: Evtl Import mit Schatten rechts-unten? Gruß owT
von: Luc:-?
Geschrieben am: 27.09.2015 14:07:03
:-?

Bild

Betrifft: Das war's leider nicht
von: Kasimir
Geschrieben am: 27.09.2015 14:36:41
Hallo Luc!
Danke Dir für den Tipp, aber das Bild wird ohne irgendwelche Einstellungen eingefügt. Es wird mit der Einstellung "keine Schatten" eingefügt.
MfG,
Kasimir

Bild

Betrifft: AW: Mailbody mit Bild aus Tabellenblatt?
von: Beverly
Geschrieben am: 27.09.2015 15:46:10
Hi Kasimir,
hast du schon mal versucht, das Bild nicht als PNG- sondern (wie in meinem Code) als JPG zu exportieren?




Bild

Betrifft: AW: Mailbody mit Bild aus Tabellenblatt?
von: Kasimir
Geschrieben am: 27.09.2015 15:49:58
Hallo Karin!
Ja klar, das hatte ich zuerst probiert. Das Ergebnis sieht aber genauso aus wie in dem Screenshot zu sehen.
MfG,
Kasimir

Bild

Betrifft: AW: Mailbody mit Bild aus Tabellenblatt?
von: Nepumuk
Geschrieben am: 27.09.2015 16:19:05
Hallo,
dann versuch es mal damit:

Option Explicit

Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleaut32.dll" ( _
    ByRef PicDesc As PICT_DESC, _
    ByRef RefIID As GUID, _
    ByVal fPictureOwnsHandle As LongPtr, _
    ByRef IPic As IPicture) As LongPtr
Private Declare PtrSafe Function CopyImage Lib "user32.dll" ( _
    ByVal handle As LongPtr, _
    ByVal un1 As Long, _
    ByVal n1 As Long, _
    ByVal n2 As Long, _
    ByVal un2 As Long) As LongPtr
Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32.dll" ( _
    ByVal wFormat As Long) As Long
Private Declare PtrSafe Function OpenClipboard Lib "user32.dll" ( _
    ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function GetClipboardData Lib "user32.dll" ( _
    ByVal wFormat As Long) As LongPtr
Private Declare PtrSafe Function DeleteObject Lib "gdi32.dll" ( _
    ByVal hObject As LongPtr) As Long
Private Declare PtrSafe Function CLSIDFromString Lib "ole32.dll" ( _
    ByVal lpsz As Any, _
    ByRef pCLSID As GUID) As Long
Private Declare PtrSafe Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32.dll" () As Long

Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type

Private Type PICT_DESC
Size As Long
Type As Long
    hPic As LongPtr
    hPal As LongPtr
End Type

Private Const PICTYPE_BITMAP As Long = 1
Private Const CF_BITMAP As Long = 2
Private Const IMAGE_BITMAP As Long = 0
Private Const LR_COPYRETURNORG As Long = &H4
Private Const GUID_IPICTUREDISP As String = "{7BF80981-BF32-101A-8BBB-00AA00300CAB}"

Private Function PastePicture(ByRef prlngptrCopy As LongPtr) As IPictureDisp
    
    Dim lngReturn As Long, lngptrPointer As LongPtr
    
    If Cbool(IsClipboardFormatAvailable(CF_BITMAP)) Then
        
        lngReturn = OpenClipboard(CLngPtr(Application.hwnd))
        
        If lngReturn > 0 Then
            
            lngptrPointer = GetClipboardData(CF_BITMAP)
            
            prlngptrCopy = CopyImage(lngptrPointer, _
                IMAGE_BITMAP, 0&, 0&, LR_COPYRETURNORG)
            
            Call CloseClipboard
            
            If lngptrPointer <> 0 Then Set PastePicture = _
                CreatePicture(prlngptrCopy, 0)
            
        End If
    End If
End Function

Private Function CreatePicture( _
        ByVal lngptrhPic As LongPtr, _
        ByVal lngptrhPal As LongPtr) As IPictureDisp

    
    Dim udtPicInfo As PICT_DESC, udtID_IDispatch As GUID
    Dim objPicture As IPictureDisp
    
    Call CLSIDFromString(StrPtr( _
        GUID_IPICTUREDISP), udtID_IDispatch)
    
    With udtPicInfo
        .Size = Len(udtPicInfo)
        .Type = PICTYPE_BITMAP
        .hPic = lngptrhPic
        .hPal = lngptrhPal
    End With
    
    Call OleCreatePictureIndirect(udtPicInfo, _
        udtID_IDispatch, 0&, objPicture)
    
    Set CreatePicture = objPicture
    
    Set objPicture = Nothing
    
End Function

Public Sub ExportPicture()
    
    Dim lngptrCopy As LongPtr
    Dim objPicture As IPictureDisp
    
    Call OpenClipboard(0&)
    Call EmptyClipboard
    Call CloseClipboard
    
    Worksheets("Tabelle1").Shapes(1).CopyPicture _
        Appearance:=xlScreen, Format:=xlBitmap
    
    Set objPicture = PastePicture(lngptrCopy)
    
    If objPicture Is Nothing Then
        MsgBox "Picture can't store on Drive", vbCritical, "Error"
    Else
        Call SavePicture(Picture:=objPicture, Filename:=ThisWorkbook.Path & "\Temp.bmp")
    End If
    
    Call DeleteObject(lngptrCopy)
    
End Sub

Gruß
Nepumuk

Bild

Betrifft: AW: Mailbody mit Bild aus Tabellenblatt?
von: Kasimir
Geschrieben am: 27.09.2015 16:41:07
Hallo Nepumuk!
Danke Dir für Deine Lösung. Das funktioniert, aber warum? Also woran lag es denn, dass mit dem Makro von Karin die Ränder angezeigt wurden?
Danke nochmal an alle und Gruß,
Kasimir

Bild

Betrifft: AW: Mailbody mit Bild aus Tabellenblatt?
von: mumpel
Geschrieben am: 27.09.2015 17:05:02
Hallo!

Zitat:
(...) Also woran lag es denn, dass mit dem Makro von Karin die Ränder angezeigt wurden? (...)
____________________________
Quelle: Herber-Forum


Karins Code nutzt, wenn ich das jetzt richtig interpretiere, die interne Excel-interne Exportfunktion. Und die ist, höflich ausgedrückt, schlecht.
Gruß, René

Bild

Betrifft: AW: Mailbody mit Bild aus Tabellenblatt?
von: Kasimir
Geschrieben am: 27.09.2015 17:08:49
Hallo René!
Danke Dir für Deine Antwort.
MfG,
Kasimir

Bild

Betrifft: AW: Mailbody mit Bild aus Tabellenblatt?
von: mumpel
Geschrieben am: 27.09.2015 17:13:11
Zudem speichert Nepumuks Code als Bitmap, Karins Code als jpg.

Bild

Betrifft: AW: Mailbody mit Bild aus Tabellenblatt?
von: Beverly
Geschrieben am: 27.09.2015 17:18:15
Hi Kasimir,
das würde ich nicht so definitiv behaupten, denn das Bild selbst ist korrekt exportiert (schau es dir einfach mal im Ordner an bzw. im Screenshot der Windows-Fotoanzeige), nur wird es in der Mail nicht korrekt dargestellt.
Userbild




Bild

Betrifft: AW: Mailbody mit Bild aus Tabellenblatt?
von: mumpel
Geschrieben am: 27.09.2015 18:34:03
Eventuell hilft es ja auch das img-Tag den TML-Reglen entsprechend sauber zu erstellen.
.HTMLBody = "<img src='Pfad\Bild.jpg' border='0' alt='bild1' title='bild1'>"

Bild

Betrifft: Das unterstreicht meinen Hinweis - o.w.T.
von: Beverly
Geschrieben am: 27.09.2015 19:10:04




 Bild

Beiträge aus den Excel-Beispielen zum Thema "Mailbody mit Bild aus Tabellenblatt?"