VBA Diagramm in E-Mail einbinden

[Olerostock]

Moin zusammen,

ich lasse über VBA eine E-Mail mit einer Tabelle erstellen und möchte nun zusätzlich ein Diagramm einfügen.
Das Diagramm befindet sich auf Sheets "Diagramme" "B4:I41". Als Range geht nicht. Wie kann ich es sonst einbinden?
Folgenden Code verwende ich.

Dim OutlookApp As Object
Dim rng As Range
Dim OutlookMail As Object
Set rng = Sheets("Tabelle").Range("B5:N43")
With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With


Könnt ihr mir hier einen Vorschlag machen?

Danke und mit besten Grüßen
Ole

[knobbi38]

Hallo Ole,

du könntest versuchen, das Diagramm als Bild/Grafik abzuspeichern und dieses dann in deiner Mail einzubinden bzw. als Anhang mit ausliefern. Dann kann auch jeder Empfänger das Bild öffnen und ansehen.

Gruß
Knobbi38

[derHoepp]

Moin,

alternativ zu Ulrichs Vorschlag kannst du statt des HTML-Quelltexts auch die eingebaute Word-Instanz fernsteuern. Wenn ich mich recht erinnere (du hast leider nicht geschrieben, wie du deine Mail erzeugst), verwendest du derzeit den Umweg über das Publish-Objekt um einen HTML-Quelltext zu generieren. Wenn du über die Word-Objekte gehen willst, musst du entsprechend dein gesamtes Vorgehen anpassen:

Code:

Sub test2()
    Dim out As Object
    Dim olMailItem As Long
    olMailItem = 0
    Set out = GetObject(, "Outlook.Application")
    With out
        Dim msg As Object
        Set msg = out.CreateItem(olMailItem)
       
        Dim insp As Object
        Set insp = msg.getinspector()
        insp.display
        Me.ChartObjects(1).Chart.CopyPicture
        insp.Wordeditor.Range(0, 1).Paste
        'msg.Save
    End With
End Sub

Viele Grüße
derHöpp

[Olerostock]

Moin Höpp,

ich gehe den Umweg über die Funktion RangetoHTML.

Gruß Ole

[derHoepp]

Moin,

RangeToHTML ist keine Standardfunktion, was du da konkret nutzt, kann ich also nicht beurteilen. Jedenfalls wird dann der von Ulrich vorgeschlagene Weg der richtige sein. Die folgenden Schritte musst du tun:
- Zunächst das Diagramm als Grafik speichern,
- als Attachment der Mail hinzufügen und
- im HTML-Quelltext auf das Attachment verweisen.

Dafür brauchst du eigentlich nur grundlegende Kenntnisse im Outlook-Objektmodell, und Basiswissen für HTML.

Viele Grüße
derHöpp

[Olerostock]

Moin Höpp,

hier ist die Funktion.

Code:

Function RangetoHTML(rng As Range)

Dim TempFile As String
Dim TextStream As Object
Dim FSO As Object
Dim TempWB As Workbook
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
    .Cells(1).PasteSpecial Paste:=8
    .Cells(1).PasteSpecial xlPasteValues, , False, False
    .Cells(1).PasteSpecial xlPasteFormats, , False, False
    .Cells(1).Select
    Application.CutCopyMode = False
    On Error Resume Next
    .DrawingObjects.Visible = True
    .DrawingObjects.Delete
    On Error GoTo 0
End With
With TempWB.PublishObjects.Add( _
     SourceType:=xlSourceRange, _
     Filename:=TempFile, _
     Sheet:=TempWB.Sheets(1).Name, _
     Source:=TempWB.Sheets(1).UsedRange.Address, _
     HtmlType:=xlHtmlStatic)
    .Publish (True)
End With
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TextStream = FSO.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = TextStream.ReadAll
TextStream.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
     "align=left x:publishsource=")
TempWB.Close SaveChanges:=False
Kill TempFile
Set FSO = Nothing
Set TempWB = Nothing
Set TextStream = Nothing
End Function

Hier die E-Mail, in der die Grafik eingefügt werden soll.

Code:

Sub Mail_IV_4()

'Zahlen für TEC

Dim OutlookApp As Object
Dim rng As Range
Dim OutlookMail As Object
Set rng = Sheets("Zahlen").Range("B5:N43")
With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)

With OutlookMail
    .To = "alpha@abc.de"
    .CC = "beta@abc.de"
    .Subject = "Zahlen Technik vom: " & Sheets("Zahlen").Range("A1")
    .HTMLBody = "<HTML><Body>Hallo zusammen,<br><br>anbei sind die Availbench-Werte vom Vortag, sowie die bereits erfolgten Malusfreigaben dargestellt.<br>Erfüllung 'ja' berücksichtigt Bereitzeiten über der jeweiligen Availbench-Grenze.<br><br></Body><HTML>" + RangetoHTML(rng)
    .Display
End With
On Error GoTo 0
With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub

[derHoepp]

Moin,

ich habe kein gesondertes Interesse daran, mich extra in deine Struktur einzuarbeiten, um dir eine kostenlose Fertiglösung zu bauen. Ich bin der Überzeugung, dass du mehr lernst, wenn du dir die Lösung erarbeitest. Als Startpunkt kannst du den folgenden Code analysieren, verstehen und anpassen:

Code:

Sub test3()
    Dim out As Object
    Dim olMailItem As Long
    olMailItem = 0
    Set out = GetObject(, "Outlook.Application")
    With out
        Dim msg As Object
        With .CreateItem(olMailItem)
            Me.ChartObjects(1).Chart.Export "C:\Daten\Chart.png"
            Dim att As Object
            Set att = .attachments.Add("C:\Daten\Chart.png")
            .htmlbody = "<head><style>.meinText{font-family: Arial, Helvetica, sans-serif;color:#ffaa00;}</head><body><p class=""meinText"">Hallo Ole,<br>hier die Grafik.<br><img src=""cid:chart.png""><br><br>Gru&szlig;,<br>derHoepp</p></body>"
            With msg.getinspector()
                .display
            End With
        End With
    End With
    Kill "C:\Daten\Chart.png"
End Sub

Viele Grüße
derHöpp

[snb]

@DerH

Paste funktioniert hier nicht, obwohl man selbst mit ctr-V das Diagramm 'pasten' kann.
Hast du einen Vorschlag ?

Code:

Sub test2()
  Sheet1.ChartObjects(1).Chart.CopyPicture
   
  With CreateObject("Outlook.Application").CreateItem(1)
    With .getinspector
      .display
      .Wordeditor.Range(0, 1).Paste
    End With
    .Save
  End With
End Sub

[derHoepp]

Moin snb,

in meinem test2 von 10:00 Uhr funktioniert es bei mir. Ich vermute, dass der Aufruf von .getInspector und/oder .Display die Zwischenablage löscht. Du müsstest also das .CopyPicture direkt vor das .Paste schreiben.

Viele Grüße
derHöpp

[snb]

Hola derH

Leider nicht:

obwohl man selbst mit ctr-V das Diagramm 'pasten' kann.

das Zwischenspeicher ist offensichtlicht nicht geleert.

Ich habe deinen Vorschlag sofort getestet aber ohne Erfolg.
Ich hatte noch einen andere Beispielcode gefunden die hier leider aucht nicht funktionierte.

Code:

  .getinspector.WordEditor.Application.Selection.Paste