Hallo zusammen, ich bräuchte mal eure hilfe.
Ich möchte gerne einen bestimmten Range bereich Kopieren und in Outlook als bild Einfügen.
Bisher klappt es auch relativ gut, nur das das Bild sich verzerrt.
Beim Manuellen Kopieren und in Outlook als Grafik einfügen bleibt die Fromatierung bzw. die Seitenverhältnisse perfekt wie in der Datei aber mit dem Code wird alles ein wenig gestreckt und zusammengeschoben und das soll es ja nicht.
Über eure hilfe würde ich mich echt freuen.
Anbei der Bisherige Code:
Option Explicit
Sub InOutlookEinfügen()
Dim oApp As New Outlook.Application
Dim oMail As Outlook.MailItem
Dim strOldBody As String
Dim Empfaenger As String
Dim CcEmpfaenger As String
Dim chtPicture As Chart
Dim strSheetName As String
Empfaenger = "email adresse1"
CcEmpfaenger = "email adresse2"
'summary als JPG auf dem Laufwerk ablegen
strSheetName = Sheets("Benanntes Arbeitsblatt").Activate
ActiveSheet.Range("A2:M55").CopyPicture Appearance:=xlScreen, Format:=xlPicture
Set chtPicture = Charts.Add
Application.Wait Now + TimeSerial(0, 0, 7)
chtPicture.Paste
Application.Wait Now + TimeSerial(0, 0, 5)
chtPicture.Export ActiveWorkbook.Path & "\" & strSheetName & ".png"
Application.DisplayAlerts = False
chtPicture.Delete
Application.DisplayAlerts = True
Set chtPicture = Nothing
'mail befüllen
Set oMail = oApp.CreateItem(olMailItem)
With oMail
.GetInspector.Display
strOldBody = .HTMLBody
.BodyFormat = olFormatHTML
.Display
.To = Empfaenger
.CC = CcEmpfaenger
.Subject = "Test"
.HTMLBody = "<b>ANREDE</b>" & "<br>" & "<b>EMAIL TEXT</b>" & "<br><br>" & "<img src=""file://O:\Adresspfad\Wahr.png"">" & "<br><br><br>" & "<b>Viele Grüße<b/>" & _
strOldBody
'kehre zu ausgangs sheet zurück
Worksheets("functions").Activate
'PNG datei wider vom Laufwerk löschen
Kill "O:\Adresspfad\Wahr.png"
'.Send
'.Save
End With
End Sub
|