2 Diagramme nebeneinander in Email
28.10.2019 21:34:59
TeimeN
ich würde gerne per VBA eine automatisch eine Email erzeugen. In dieser sollen Diagramme nebeneinander dargestellt werden. Leider habe ich keine Erfahrung mit Word VBA..
Wie kann ich nachdem ich das erste Diagramm eingefügt habe, das nächste dahinter einfügen? Ich habe mich schon wund gegooglet leider ohne erfolg...
'Diagramme einfügen
ThisWorkbook.Sheets("Sheet1").ChartObjects("Diagramm 1").Copy
wEditor.Paragraphs(Zeile).Range.Paste
Sub ChartPaste()
Dim OutApp As Object
Dim OutMail As Object
Dim vInspector As Object
Dim wEditor As Object
Dim Zeile As Integer
'Outlook öffnen und zuweisen
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Set wEditor = OutMail.GetInspector.WordEditor
Zeile = 1
Application.ScreenUpdating = False
With OutMail
'Signatur entfernen
wEditor.Range.Delete
'Empfänger wie in Tabelle definiert
.TO = "Emailadresse"
'Betreff
.Subject = "Monatlicher Bericht"
'Anrede und Zeilenumbrüche einfügen um später in die Umbrüche Diagramme einfügen zu kö _
nnen
wEditor.Paragraphs(Zeile).Range.Text = "Hallo zusammen," & vbCr & vbCr & vbCr & vbCr & _
vbCr & vbCr & vbCr & vbCr & vbCr & vbCr & vbCr & vbCr & vbCr & vbCr & vbCr & vbCr & vbCr & vbCr & vbCr & vbCr & vbCr & vbCr & vbCr & vbCr & vbCr & vbCr & vbCr & vbCr & vbCr & vbCr
'Zwei Umbrüche weiterrücken und Text einfügen
Zeile = Zeile + 2
wEditor.Paragraphs(Zeile).Range.Text = "im Anhang der monatliche Berich"
'Ein Umbruch weiter
Zeile = Zeile + 1
'3 Umbrüche weiter
Zeile = Zeile + 3
'Diagramme einfügen
ThisWorkbook.Sheets("Sheet1").ChartObjects("Diagramm 1").Copy
wEditor.Paragraphs(Zeile).Range.Paste
Zeile = Zeile + 2
wEditor.Paragraphs(Zeile).Range.Text = "(Diese Email wurde automatisch erzeugt)"
.display
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub