VBA Diagramm per E-Mail senden

[Mitness]

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 
Schon Mal vielen Dank im Voraus für jede Antwort!

Liebe Grüße
Mitness

[schauan]

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

[Mitness]

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