Microsoft Excel

Herbers Excel/VBA-Archiv

Screenshot in Mail einfügen

Betrifft: Screenshot in Mail einfügen von: Tamás
Geschrieben am: 28.11.2020 08:15:32

Hallo zusammen, ich habe folgendes Problem, ich möchte gerne einen Screenshot von einem Zellbereich machen, dieser Screenshot soll dann in eine E-Mail eingefügt werden und dann auch noch skaliert werden.


Folgenden Code benutze ich dafür:

Sub SCREENSHOT_MAIL()
Application.ScreenUpdating = False
    
Dim Betreff As String, Text As String
Dim olApp As Object
Set olApp = CreateObject("Outlook.Application")
Betreff = "Screenshot " & Sheets("Ausgabe").Range("K4").Value
        
Sheets("Quelle").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Temp\Screenshot " & Sheets("Ausgabe").Range("K4").Value & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:= _
False, IgnorePrintAreas:=False, OpenAfterPublish:=False

Application.ScreenUpdating = True
            
Sheets("Ausgabe").Range("A1:Y36").CopyPicture xlScreen, xlBitmap
    
Application.ScreenUpdating = False
    
Workbooks.Open Filename:="C:\Crop_Picture.xlsm"
Windows("Crop_Picture.xlsm").Activate
    
Sheets("Picture").Select
ActiveSheet.Paste
Selection.Width = 300
Selection.Height = 300
Selection.Copy

Application.DisplayAlerts = False
Windows("Crop_Picture.xlsm").Close
Application.DisplayAlerts = True
        
Application.ScreenUpdating = False

With olApp.CreateItem(0)
.To = Sheets("Mailversand").Range("B3").Value
.Cc = Sheets("Mailversand").Range("B4").Value
.Subject = Betreff
.Attachments.Add "C:\Temp\Screenshot " & Sheets("Ausgabe").Range("K4").Value & ".pdf"
.Display
End With


' einfügen aus Zwischenablage
' "^" steht für Strg
        
SendKeys "^v", True
SendKeys "{NUMLOCK}", True
    
Set olApp = Nothing
Set Rng = Nothing

Sheets("Ausgabe").Select

Application.ScreenUpdating = True
End Sub
Der Zellbereich der als Screenshot in die Mail eingefügt werden soll wird auch als PDF Datei gespeichert und an die Mail angehangen, das klappt mit o.g. Code problemlos. Das Einfügen des Screenshots klappt auch, naja meistens.

Erste Vorraussetzung ist, das Mailprogramm, in meinem Fall Outlook, muss bereits geöffnet sein. Wenn nicht läuft das Makro auf einen Fehler. Aber selbst wenn das Mailprogramm bereits geöffnet ist, kommt es beim ersten Versuch auch zu 99% zu einer Fehlermeldung, dann wird zwar eine Mail erstellt, inkl. PDF Datei im Anhang usw, aber das Einfügen des Screenshots klappt dann nicht. Vermutlich liegt das am "SendKeys". Wenn ich diese Mail ohne Screenshot dann schließe und das Makro erneut ausführe klappt es in der Regel auch dass die Mail inkl. Screenshot erzeugt wird.

Das zweite Ding ist die Sache mit dem skalieren. Am liebsten würde ich den Screenshot über eine fixe Höhe oder Breite automatisch in der Mail skalieren. Aber ich finde dazu keinen Ansatzpunkt. Daher gehe ich über eine eigens dafür erstellte, ansonsten leere Excel Datei, füge den Screenshot dort ein und skaliere mit einer bestimmten Höhe und einer bestimmten Breite, dadurch kommt es natürlich vor dass der Screenshot verzert wird, denn die Ausgangsbreite und Höhe sind nicht immer gleich.

Wonach ich jetzt suche ist eine Möglichkeit den Code zu optimieren. Ich möchte dass das Erzeugen einer Mail immer schon im ersten Versuch inkl. Screenshot klappt, am liebsten wie gesagt mit der Skalierung des Screenshots in Outlook, und die Skalierung entweder auf Breite oder Höhe, so dass das Seitenverhältnis erhalten bleibt.

Ich würde mich wahnsinnig freuen wenn es hier eine Lösung für meine Probleme gäbe.

Vielen Dank schonmal im Vorraus

Viele Grüße
Tamás

Betrifft: AW: Screenshot in Mail einfügen
von: volti
Geschrieben am: 28.11.2020 09:12:55

Hallo Tamás,

schau mal, ob Du mit meinem angepassten (aber ungetesten) Beispiel etwas anfangen kannst.

Code:
[Cc][+][-]

Sub SCREENSHOT_MAIL() 'Sendet Mail mit integriertem Bereich als Bild mit Signatur Dim sMailtext As String, sDateiname As String Dim iEinf As Integer, oShp As Object Dim WSh1 As Worksheet, WSh2 As Worksheet Dim sBetreff As String Set WSh1 = Sheets("Mailversand") 'Blatt referenzieren Set WSh2 = Sheets("Ausgabe") 'Blatt referenzieren sBetreff = "Screenshot " & WSh2.Range("K4").Value sDateiname = "C:\Temp\Screenshot " & WSh2.Range("K4").Value & ".pdf" Sheets("Quelle").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ sDateiname, _ Quality:=xlQualityStandard, IncludeDocProperties:=False, _ IgnorePrintAreas:=False, OpenAfterPublish:=False On Error Resume Next Do WSh2.Range("A1:Y36").CopyPicture _ Appearance:=xlScreen, Format:=xlBitmap 'Bereich kopieren, ggf. xlPicture If Err.Number = 0 Then Exit Do 'Bei Problemen Err.Clear 'mehrfach versuchen Loop On Error GoTo 0 With CreateObject("Outlook.Application").CreateItem(0) .BodyFormat = 2 '2=HTML-Format, 3=Richtext .Subject = sBetreff 'Betreff" .To = WSh1.Range("B3").Value 'Empfänger .Cc = WSh1.Range("B4").Value 'Kopie sMailtext = "Hallo," & vbLf & "hier die Daten" & vbLf .Getinspector: 'Signatur holen .htmlbody = Replace(sMailtext, vbLf, "<br>") & .htmlbody .Display iEinf = Len(sMailtext) 'Grafik Einfügestelle, ggf. justieren With .Getinspector.WordEditor.Application.Selection .Start = iEinf: .End = iEinf .Paste 'Grafik in Mail einfügen End With For Each oShp In .Getinspector.WordEditor.InlineShapes oShp.Width = 300 'Grafik skalieren Next oShp 'Anlage dran .Attachments.Add sDateiname End With End Sub

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz


Betrifft: AW: Screenshot in Mail einfügen
von: Tamás
Geschrieben am: 28.11.2020 10:49:45

Hallo Karl-Heinz aka Volti,

vielen lieben Dank für Deine Mühe. Dein Code funktioniert ganz hervorragend. Ich bin absolut begeistert! Vor allem hätte ich auf einen Samstag Morgen nicht mit so schneller Hilfe gerecht. Herzlichen Dank nochmal.

Gruß
Tamás

Betrifft: AW: Screenshot in Mail einfügen
von: volti
Geschrieben am: 28.11.2020 14:10:21

Hallo Tamás,

vielen Dank für die positive Rückmeldung. Das motiviert einen, weiter zu machen 😊

VG KH

Beiträge aus dem Excel-Forum zum Thema "Screenshot in Mail einfügen"