Clever-Excel-Forum

Hallo liebe Community,

ich möchte von meinem worksheet "diagramme" gerne ausgewählte Diagramme per E-Mail versenden. Ich habe dafür auch schon einen passenden VBA Code, der auch soweit gut funktioniert.
Ich hätte jetzt nur gerne den noch um folgendes Erweitert:

- Auswahl von mehreren Diagrammen Möglich, sprich das mehrere Diagramme ausgewählt werden können und einzeln als .bmp Datei im Anhang der E-Mail befinden.
- Anstatt den Username in den Dateinamen zu integrieren hätte ich lieber den Diagrammnamen z. B. "Diagramm1_Datum.bmp"

Hier der Code:

Code:
Sub mailHTMLsend()

'Updated by Extendoffice 2018/3/5

    Dim xOutApp As Object

    Dim xOutMail As Object

    Dim xStartMsg As String

    Dim xEndMsg As String

    Dim xChartName As String

    Dim xChartPath As String

    Dim xPath As String

    Dim xChart As ChartObject

    On Error Resume Next

    xChartName = Application.InputBox("Please enter the chart name:", "", , , , , , 2)

    If xChartName = "" Then Exit Sub

    Set xChart = Sheets("diagramme").ChartObjects(xChartName)

    If xChart Is Nothing Then Exit Sub

    Set xOutApp = CreateObject("Outlook.Application")

    Set xOutMail = xOutApp.CreateItem(0)

    xStartMsg = "<font size='5' color='black'> Good Day," & "<br> <br>" & "Please find the chart below: " & "<br> <br> </font>"

    xEndMsg = "<font size='4' color='black'> Many Thanks," & "<br> <br> </font>"

    xChartPath = ThisWorkbook.Path & "\" & Environ("USERNAME") & VBA.Format(VBA.Now(), "DD_MM_YY_HH_MM_SS") & ".bmp"

    xPath = "<p align='Left'><img src=" / "cid:" & Mid(xChartPath, InStrRev(xChartPath, "\") + 1) & """  width=700 height=500 > <br> <br>"

    xChart.Chart.Export xChartPath

    With xOutMail

        .To = "test@mail.de"

        .Subject = "Add Chart in outlook mail body"

        .Attachments.Add xChartPath

        .HTMLBody = xStartMsg & xPath & xEndMsg

        .Display

    End With

    Kill xChartPath

    Set xOutMail = Nothing

    Set xOutApp = Nothing

End Sub

Ich hoffe jemand kann mir helfen Huh

Schon Mal vielen Dank im Voraus für jede Antwort!

Liebe Grüße
Mitness

Hallöchen,

hier mal der Ansatz für den Export selektierter Diagramme ...

Code:
Sub test()

Dim irgendwas

Dim xChart As Chart ' As ChartObject

For Each irgendwas In Selection

  Set xChart = irgendwas.Chart

  xChart.Export "C:\Test\" & irgendwas.Chart.Name & ".jpg", "jpg"

Next

End Sub

wobei Du auf xChart verzichten kannst, es würde irgendwas.chart.export ... reichen

Supi, ich Danke dir! Ich werde es gleich Mal testen und dann wieder antworten.

Also deine Methode funktioniert soweit gut, sie legt im gewünschten Archiv die ausgewählten Diagramme als .jpg ab.
Ich bekomme es nicht hin die Prozedur in meine per E-Mail Prozedur einzubetten. Könntest du mir da helfen?

Liebe Grüße

Mitness

schauan

Mitness