Office: Excel Range als Bild in email

Hi,

habe ein kleines Prob.
Aus ein Sheet sende ich einen Bereich an eine Person

PHP:

         ElseIf Thema = "News" Then
mailreceiver = Range("Y58") & ";" & Range("Z58") & ";" & Range("AA58")
Datum = Range("Y59")
Set CopyRange = ActiveSheet.Range("X56:AA59")


:)

 

Hallo,

habe grad ein Beispiel in einem anderen Forum gepostet, wie ich das machen würde.
Vielleicht kannst Du ja damit etwas anfangen und/oder das auf Deinen Code anpassen.

Code:


[+][-]

____________
viele Grüße
Karl-Heinz

 

Danke aber bringt mit nicht wirklich was.
Wenn ich
CopyRange("X56:AA59").CopyPicture xlScreen, xlBitmap

verwende anstatt Range dann bekomme Fehler 91
Bin mir auch nicht sicher ob ich das Bild so einfügen kann.
Meine ich habe es mal hinbekommen aber lange her :-)

So würde ich es mir vorstellen

Set CopyRange = ActiveSheet.Range("X56:AA59").CopyPicture xlScreen, xlBitmap

 

Hallo,

Du hast mit "Set CopyRange = ActiveSheet.Range("X56:AA59")" den gewünschten Bereich doch schon dem Range-Objekt CopyRange zugewiesen und willst nun diesem RangeObjekt noch mal den Bereich beibiegen?!

Das geht natürlich nicht.

Entweder
CopyRange.CopyPicture xlScreen, xlBitmap

oder z.B.
ActiveSheet.Range("X56:AA59").CopyPicture xlScreen, xlBitmap

oder noch besser
ActiveSheet.Range("X56:AA59").CopyPicture Appearance:=xlScreen, Format:=xlBitmap

Und wenn Du Dir nicht sicher bist, ob Du das Bild so einfügen kannst wie ich es gezeigt habe; ich bin mir sicher.

viele Grüße
Karl-Heinz

 

Hi KH,

bekomme immer noch einen Laufzeitfehler 91
Habe
Set CopyRange
wo er einmal anmekert oder einmal dann zum Schluß
CopyRange.Copy
objdata.GetFromClipboard
varBody = objdata.GetText
Habe im Header den CopyRange as Range definiert.
Steige leider nicht so durch wie du :-)

 

Hallo,

wenn Du schon nicht mein gezeigtes Beispiel für Deine Aktivitäten nutzen möchtest, solltest Du hier mal Deinen gesamten relevanten Code zeigen oder besser gleich eine Beispieldatei hochladen.

Mit den hier gezeigten, unzusammenhängenden Fragmenten kann ja kein Mensch etwas anfangen.

Der u.a. gezeigte Beispielcode läuft z.B. fehlerfrei, wobei der zweite Teil ja nur Text aus der Zwischenablage holt. Ich dachte, Du wolltest ein Bild einfügen?!
Code:

____________
viele Grüße
Karl-Heinz

 

Hi KH,

Danke für deine Hilfe.

In dem Excelshett habe ich in diesem Bereich

Emailthema = ElseIf Thema = "News" Then
Mehrere Empfänger = mailreceiver = Range("Y58") & ";" & Range("Z58") & ";" & Range("AA58")
Datum = Datum = Range("Y59")
Gesamter Bereich = Set CopyRange = ActiveSheet.Range("X56:AA59")
Gesmter Bereich Bild = CopyRange.CopyPicture xlScreen, xlBitmap

Im Textformat funktioniert dies alles prima aber ist halt schlecht lesbar, da alles zerhauen wird vom Format.
Ein eingefügtes Bild wäre halt etwas hübscher :-)

Habe jetzt das so eingefügt wie aufgeführt hast.
Klappt alles aber das Bild ist nicht vorhanden.
Der Varbody habe ich als Dim varbody As String
Denke es wird immer als Text eingefügt und nicht als Bild.

cu

 

Sorry,

aber ich sehe wieder nur undurchsichtigen (Prosa)Teilcode wie

Gesamter Bereich = Set CopyRange = ActiveSheet.Range("X56:AA59")
Gesmter Bereich Bild = CopyRange.CopyPicture xlScreen, xlBitmap

Wo ist der Rest des Mailcodes?
Wo wird hier etwas, z.B. das Bild, eingefügt?

Da kann ich leider Dir nicht helfen.

viele Grüße
Karl-Heinz

 

Sorry, dachte der Code von dir führt das Bild einfügen aus.

Hier mal der Code:

PHP:

         Sub Mail_verfassen()

'If IsEmpty(ActiveSheet.Range("V10").Value) And Thema = "Round" Or IsEmpty(ActiveSheet.Range("V34").Value) And Thema = "News" Or IsEmpty(ActiveSheet.Range("V76").Value) And Thema = "Race" Then
'MsgBox ("Bitte einen Verantwortlichen auswŠhlen")
'Exit Sub
'End If

Dim objol As New Outlook.Application
Dim objmail As MailItem
Dim varbody As String
Dim objdata As DataObject
Dim oData   As New DataObject
Dim mailreceiver As String
Dim mailsubject As String
Dim Datum As Date
Const olAppointmentItem As Long = 1
Dim OLApp As Object
Dim OLNS As Object
Dim OLAppointment As Object
Dim CopyRange As Range

'Dim oApp As Object


Set objol = New Outlook.Application
Set objmail = objol.CreateItem(olMailItem)
'Set objmail = objol.CreateItem(olAppointmentItem)
Set objdata = New DataObject

If Thema = "Round" Then
mailreceiver = Range("Y10") & ";" & Range("Z10") & ";" & Range("AA10")
Datum = Range("Y11")
Set CopyRange = ActiveSheet.Range("X8:AA11")



ElseIf Thema = "News" Then
mailreceiver = Range("Y58") & ";" & Range("Z58") & ";" & Range("AA58")
Datum = Range("Y59")
Set CopyRange = ActiveSheet.Range("X56:AA59")


End If

CopyRange.Copy

Set objdata = New DataObject
objdata.GetFromClipboard
varbody = objdata.GetText(1)
Debug.Print varbody





If IsEmpty(Datum) Then Datum = Date

On Error Resume Next
Set OLApp = CreateObject("Outlook.Application")

If Not OLApp Is Nothing Then

'        Set OLNS = OLApp.GetNamespace("MAPI")
'        OLNS.Logon

'  Set OLAppointment = OLApp.CreateItem(olMeeting) 'AppointmentItem
' OLAppointment.Subject = ActiveSheet.Name & " Ð " & Thema
'OLAppointment.Start = Datum & " 7:30:00 AM"
'OLAppointment.Duration = "30"
'OLAppointment.ReminderMinutesBeforeStart = "15"
Set OLAppointment.Body = "Hallo Herr " & mailreceiver & "," & vbCrLf & vbCrLf & varbody & vbCrLf & "" & vbCrLf
OLAppointment.Recipients.Add (mailreceiver)
OLAppointment.Display

Set OLAppointment = Nothing
Set OLNS = Nothing
Set OLApp = Nothing
End If

'Set oApp = CreateObject("Outlook.Application")

With objmail
'With oApp.CreateItem(0)
'   Application.Wait 1
.To = mailreceiver
.Subject = ActiveSheet.Name & " Ð " & Thema
.Start = Datum
.Body = "Hallo " & mailreceiver & "," & vbCrLf & vbCrLf & varbody & vbCrLf & "" & vbCrLf

.Display
SendKeys "{END}", True
SendKeys "~", True
SendKeys "^v", True
SendKeys "~", True

.NoAging = True
.Display
.Send
End With

'Set oApp = Nothing

oData.SetText Text:=Empty Clear Clipboard
oData.GetFromClipboard
oData.PutInClipboard

Set objmail = Nothing
Set objol = Nothing
Set objdata = Nothing

End Sub


 

Hier eine Idee,

die Du verwenden könntest....

Code:


[+][-]

____________
viele Grüße
Karl-Heinz

 

Boah Danke!
Aber glaube bevor ich das alles neu mache, erstelle ich lieber separate mails.
Hatte gehofft ein einfaches Copy.Picture Range reicht.

cu

 

delete