Range an Fkt in anderem Workbook übergeben
24.03.2013 10:26:34
Florian
habe ein Problem, bei dem ich nicht ganz weiterkomme. Wäre super, wenn mir einer von Euch evt helfen könnte.
Ausgangsbasis ist eine Funktion, die aus Excel heraus eine Mail aufsetzt. Diese Mail soll eine xls-Range im Body anzeigen. Über eine weitere Prozedur wird diese Funktion aufgerufen (mit den jeweiligen Argumenten, die Range ist dabei im Worksheet benannt), was auch funktioniert (Mail wird generiert).
Problem ist nun folgendes: die aufrufende Prozedur soll in einem anderen Workbook stehen. Prinzipiell funktioniert der Ansatz, jedoch nur, wenn keine Range übergeben wird. Ziel ist es aber, dass die Range im aufrufenden Workbook definiert ist, und diese dann der Funktion im externen Workbook übergeben werden, die schliesslich die Mail generiert.
Hätte von Euch evt jemand einen Vorschlag?
Vielen Dank im Voraus, und ein schönes Wochenende noch.
Gruss
Florian
Hier der Code:
Sub Call_Fkt_und_uebergib_Range()
'diese Prozedur ist in einem anderen Workbook
'funktioniert nur, wenn die Range weggelassen wird, diese soll aber übergeben werden
Application.Run "called_easyMail2nd.xlsm!easyMail2nd(""MyReport"";41000;Range(""range_to_show"") _
)"
End Sub
'******************************************************************
Sub CallMail()
'wenn die AUfruf-Makro im gleichen Workbook ist, funktioniert der Aufruf
Call MachMail("MyReport", 41000, Range("range_to_show"))
End Sub
Function MachMail(strReportType As String, dtReferDate As Date, rngTxt As Range)
'Dim rng As Range
Dim olApplication As Object
Dim objEMail As Object
Set olApplication = CreateObject("Outlook.Application")
Set objEMail = olApplication.CreateItem(olMailItem)
With objEMail
.To = "receiverMail"
.Subject = "HELLO TEST: date " & strReportType & "---" & Format(dtReferDate, "dd-mm-yyyy")
.HTMLBody = RangetoHTML(rngTxt)
.display
End With
Set rng = Nothing
Set objEMail = Nothing
End Function
Function RangetoHTML(rng As Range)
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"
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 GoTo 0
End With
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
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= _
")
TempWB.Close savechanges:=False
Kill TempFile
Set ts = Nothing
Set Fso = Nothing
Set TempWB = Nothing
End Function