Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1476to1480
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Excel Ausschnitt auto. in Email kopieren

Excel Ausschnitt auto. in Email kopieren
03.03.2016 14:31:02
Michel
Hallo zusammen
Ich hoffe ihr könnt mir in dieser Angelegenheit helfen.
Im folgenden file habe ich ein kleines Macro geschrieben:

https://www.herber.de/bbs/user/104073.xlsm

Dieses Macro kopiert Daten von einer anderen Excel Tabelle, welche vom SAP generiert wird.
Mein Wunsch wäre, dass Macro wie folgt zu ergänzen:
- Es soll automatisch eine neue Mail generieren und soll folgende definierte Daten enthalten:
- Empfänger
- Betreff
- Standart Mail text
- Nun soll der kopierte Ausschnitt der Excel noch unter den Text als Bild eingefügt werden.
siehe bsp.
Userbild
Ist das möglich?
Vielen Dank
Gruss
Michel

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Excel Ausschnitt auto. in Email kopieren
03.03.2016 15:05:37
Michel
Hallo Selli
Vielen Dank
Was ich nun geschaft habe ist, dass ein Email mit den definierten Daten aufgeht.
Wie kann ich aber nun den kopierten Excel Ausschnitt als Bild in die E-Mail Maske einfügen?
Nicht als Anhang
Mein Code ist im mom wie folgt:

Sub Berechnen()
' Macro von Fuat Bajrami
' Kopieren von SAP Daten
'Löschen der Rohdaten
Windows("Formel von WiP Lose.xlsm").Activate
Sheets("Rohdaten").Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.ClearContents
Range("A2").Select
'Kopieren der SAP Daten
Windows("Tabelle von ALVXXL01 (1)").Activate
Sheets("Tabelle1").Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'Kopierte Daten einfügen
Windows("Formel von WiP Lose.xlsm").Activate
Sheets("Rohdaten").Select
Range("A2").Select
ActiveSheet.Paste
' Text in Zahl umwandeln
Worksheets("Rohdaten").Activate
With Range("H2:H1000")
.NumberFormat = "General"
.Value = .Value
End With
' Feld kopieren
Worksheets("30.11").Activate
Range("B2:J14").Select
Selection.Copy
End Sub
und zusätzlich würde ich den für das Mail verwenden:

Application.DisplayAlerts = False
Dim aws As String
Dim olapp As Object
ActiveWorkbook.ActiveSheet.Copy
ActiveWorkbook.Save
aws = ActiveWorkbook.FullName
Set olapp = CreateObject("Outlook.Application")
With olapp.CreateItem(0)
.to = "Email"
.CC = "Email"
.BCC = "Email"
.ReadReceiptRequested = True
'.htmlbody = "Text"
.Subject = "Bsp."
.ReadReceiptRequested = True
.Attachments.Add aws
.display
'SendKeys "%s", True ' optional Mail sofort senden
Set olapp = Nothing
Application.DisplayAlerts = True
End With
End Sub
leider fügt dieser Code mir das Excel als Anhang in die Mail, dass möchte ich eigentlich nicht.
sorry für diese Frage, aber ich bin leider kein VBA profi.. :)

Anzeige
AW: Excel Ausschnitt auto. in Email kopieren
03.03.2016 15:14:22
Michel
Hallo Selli
Vielen Dank
Was ich nun geschaft habe ist, dass ein Email mit den definierten Daten aufgeht.
Wie kann ich aber nun den kopierten Excel Ausschnitt als Bild in die E-Mail Maske einfügen?
Nicht als Anhang
Mein Code ist im mom wie folgt:

Sub Berechnen()
' Macro von Fuat Bajrami
' Kopieren von SAP Daten
'Löschen der Rohdaten
Windows("Formel von WiP Lose.xlsm").Activate
Sheets("Rohdaten").Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.ClearContents
Range("A2").Select
'Kopieren der SAP Daten
Windows("Tabelle von ALVXXL01 (1)").Activate
Sheets("Tabelle1").Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'Kopierte Daten einfügen
Windows("Formel von WiP Lose.xlsm").Activate
Sheets("Rohdaten").Select
Range("A2").Select
ActiveSheet.Paste
' Text in Zahl umwandeln
Worksheets("Rohdaten").Activate
With Range("H2:H1000")
.NumberFormat = "General"
.Value = .Value
End With
' Feld kopieren
Worksheets("30.11").Activate
Range("B2:J14").Select
Selection.Copy
End Sub
und zusätzlich würde ich den für das Mail verwenden:

Application.DisplayAlerts = False
Dim aws As String
Dim olapp As Object
ActiveWorkbook.ActiveSheet.Copy
ActiveWorkbook.Save
aws = ActiveWorkbook.FullName
Set olapp = CreateObject("Outlook.Application")
With olapp.CreateItem(0)
.to = "Email"
.CC = "Email"
.BCC = "Email"
.ReadReceiptRequested = True
'.htmlbody = "Text"
.Subject = "Bsp."
.ReadReceiptRequested = True
.Attachments.Add aws
.display
'SendKeys "%s", True ' optional Mail sofort senden
Set olapp = Nothing
Application.DisplayAlerts = True
End With
End Sub
leider fügt dieser Code mir das Excel als Anhang in die Mail, dass möchte ich eigentlich nicht.
sorry für diese Frage, aber ich bin leider kein VBA profi.. :)

Anzeige
AW: Excel Ausschnitt auto. in Email kopieren
03.03.2016 15:19:18
Michel
Hallo Selli
Vielen Dank
Was ich nun geschaft habe ist, dass ein Email mit den definierten Daten aufgeht.
Wie kann ich aber nun den kopierten Excel Ausschnitt als Bild in die E-Mail Maske einfügen?
Nicht als Anhang
Mein Code ist im mom wie folgt:

Sub Berechnen()
' Macro von Fuat Bajrami
' Kopieren von SAP Daten
'Löschen der Rohdaten
Windows("Formel von WiP Lose.xlsm").Activate
Sheets("Rohdaten").Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.ClearContents
Range("A2").Select
'Kopieren der SAP Daten
Windows("Tabelle von ALVXXL01 (1)").Activate
Sheets("Tabelle1").Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'Kopierte Daten einfügen
Windows("Formel von WiP Lose.xlsm").Activate
Sheets("Rohdaten").Select
Range("A2").Select
ActiveSheet.Paste
' Text in Zahl umwandeln
Worksheets("Rohdaten").Activate
With Range("H2:H1000")
.NumberFormat = "General"
.Value = .Value
End With
' Feld kopieren
Worksheets("30.11").Activate
Range("B2:J14").Select
Selection.Copy
End Sub
und zusätzlich würde ich den für das Mail verwenden:

Application.DisplayAlerts = False
Dim aws As String
Dim olapp As Object
ActiveWorkbook.ActiveSheet.Copy
ActiveWorkbook.Save
aws = ActiveWorkbook.FullName
Set olapp = CreateObject("Outlook.Application")
With olapp.CreateItem(0)
.to = "Email"
.CC = "Email"
.BCC = "Email"
.ReadReceiptRequested = True
'.htmlbody = "Text"
.Subject = "Bsp."
.ReadReceiptRequested = True
.Attachments.Add aws
.display
'SendKeys "%s", True ' optional Mail sofort senden
Set olapp = Nothing
Application.DisplayAlerts = True
End With
End Sub
leider fügt dieser Code mir das Excel als Anhang in die Mail, dass möchte ich eigentlich nicht.
sorry für diese Frage, aber ich bin leider kein VBA profi.. :)

Anzeige
AW: Excel Ausschnitt auto. in Email kopieren
03.03.2016 15:25:56
selli
hallo michel,
im netz gefunden und an deinen bereich angepasst. adressen musst du ergänzen.
beide codes in ein standardmodul.
Sub Mail_Selection_Range_Outlook_Body()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Set rng = Nothing
On Error Resume Next
Set rng = Sheets("30.11").Range("B2:J14")
On Error GoTo 0
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.HTMLBody = RangetoHTML(rng)
.Display  'oder .send für direktes senden
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
'Copy the range and create a new workbook to past the data in
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
'Publish the sheet to a htm file
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
'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")
'Close TempWB
TempWB.Close savechanges:=False
'Delete the htm file we used in this function
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function

gruß
selli

Anzeige
AW: Excel Ausschnitt auto. in Email kopieren
03.03.2016 16:17:37
Michel
Hallo selli
Nun bin ich fast so weit =)
Habe nun den code wie folgt angepasst:

Sub Berechnen()
' Macro von Fuat Bajrami
' Kopieren von SAP Daten
'Löschen der Rohdaten
Windows("Formel von WiP Lose.xlsm").Activate
Sheets("Rohdaten").Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.ClearContents
Range("A2").Select
'Kopieren der SAP Daten
Windows("Tabelle von ALVXXL01 (1)").Activate
Sheets("Tabelle1").Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'Kopierte Daten einfügen
Windows("Formel von WiP Lose.xlsm").Activate
Sheets("Rohdaten").Select
Range("A2").Select
ActiveSheet.Paste
' Text in Zahl umwandeln
Worksheets("Rohdaten").Activate
With Range("H2:H1000")
.NumberFormat = "General"
.Value = .Value
End With
' Feld kopieren
Worksheets("30.11").Activate
Range("B2:J14").Select
Selection.Copy
Application.DisplayAlerts = False
Dim aws As String
Dim olapp As Object
Windows("Formel von WiP Lose.xlsm").Activate
Sheets("30.11").Select
Range("A2:J14").Select
Selection.Copy
aws = ActiveWorkbook.FullName
Set olapp = CreateObject("Outlook.Application")
With olapp.CreateItem(0)
.to = "FBAJRAMI@ITS.JNJ.COM; "
.CC = "mwaelti1@its.jnj.com"
.ReadReceiptRequested = True
' Mail text, welcher im E-Mail geschrieben werden will
.htmlbody = "Hallo zusammen, 
Hiermit sende ich euch die WIP Zahlen" ' Text für den Betreff .Subject = "WIP Finish" .ReadReceiptRequested = True .display 'SendKeys "%s", True ' optional Mail sofort senden Set olapp = Nothing Application.DisplayAlerts = True End With End Sub
Der Range kopiert er zwar, aber leider weiss ich nun nicht wie er diesen in das Mail einfügt.
sonst klappte alles. =)
Kannst du mir vielleicht noch einmal helfen?
Danke

Anzeige
AW: Excel Ausschnitt auto. in Email kopieren
03.03.2016 16:23:30
selli
hallo michel,
dafür ist die funktion RangetoHtml zuständig.
die hast du komplett rausgenommen.
gruß
selli

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige