Anzeige
Archiv - Navigation
1676to1680
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

VBA: Diagramm von Excel in Powerpoint kopiern

VBA: Diagramm von Excel in Powerpoint kopiern
22.02.2019 12:07:48
Excel
Hallo zusammen,
wie kann ich diese Code anpassen, dass er keine neue Slide in PowerPoint einfügt, sondern er kopiert die Diagramme und fügt es in schon bestehenden Slide?
Falls jemand mir helfen würde, wäre dankbar!
Public Sub Sub_0815()
Dim objPP As Object 'PowerPoint.Application
Dim objP As Object  'PowerPoint.Presentation
Dim objCL As Object 'PowerPoint.CustomLayout
Dim objS As Object  'PowerPoint.Slide
Dim ShRg As Object  'PowerPoint.ShapeRange
Dim i%, PrRg$
Set objPP = CreateObject("PowerPoint.Application")
Set objP = objPP.Presentations.Open("C:\Users\Ro\OneDrive\Dokumente\Liste\Bearbeitung.pptx")
Set objCL = objP.SlideMaster.CustomLayouts(1)
For i = 3 To 1 Step -1
'Druckbereich des Excel-Blattes ermitteln
PrRg$ = Worksheets(i).PageSetup.PrintArea
If Len(PrRg$) Then
'Druckbereich in die Zwischenablage als Bild kopieren
Worksheets(i).Range(PrRg$).CopyPicture
'Den Slide-Objekten ein neues Slide-Objekt voranstellen;
'diesem das CustomLayout "objCL" zuweisen
Set objS = objP.Slides.AddSlide(1, objCL)
'Die Zwischenablage am Ende der Shape-Auflistung einf?gen
Set ShRg = objS.Shapes.Paste
'Das letzte (=eingef?gte) Shape-Objekt eventuell noch anpassen
With ShRg(ShRg.Count)
.Left = 100
.Top = 200
.BackgroundStyle = 9
End With
End If
Next i
objPP.Visible = True
End Sub

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA: Diagramm von Excel in Powerpoint kopiern
24.02.2019 17:49:33
Excel
Hallo Ro,
um ein Diagramm z.B. in die 2. Folie deiner Präsentation einzufügen, kannst du den folgenden Code verwenden:
Sub Diagramm_nach_PowerPoint()
Dim cho As ChartObject
Dim datei As String
Dim i As Long
Dim objPP As Object 'PowerPoint.Application
Dim objP As Object  'PowerPoint.Presentation
Dim objCL As Object 'PowerPoint.CustomLayout
Dim objS As Object  'PowerPoint.Slide
Dim pfad As String
Dim PrRg As String
Dim sh As Object    'PowerPoint.Shape
Dim ShRg As Object  'PowerPoint.ShapeRange
Dim wb As Workbook
Dim ws As Worksheet
pfad = "C:\Users\Ro\OneDrive\Dokumente\Liste\"
datei = "Bearbeitung.pptx"
If Dir(pfad & datei) = "" Then
MsgBox pfad & datei & vbNewLine & "existiert nicht"
Exit Sub
End If
Set objPP = CreateObject("PowerPoint.Application")
Set objP = objPP.Presentations.Open(pfad & datei)
Set objS = objP.Slides(2)
' Folie 2 bis auf den Titel leeren
For i = objS.Shapes.Count To 1 Step -1
If objS.Shapes(i).Name  "Titel 1" Then
objS.Shapes(i).Delete
End If
Next i
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Diagramm")
Set cho = ws.ChartObjects(1)
cho.CopyPicture
Set ShRg = objS.Shapes.PasteSpecial(DataType:=0) ' ppPasteDefault = 0
ShRg.Left = 100
ShRg.Top = 200
objP.Save
objP.Close
objPP.Quit
End Sub

Das Löschen von auf Folie 2 bereits vorhandenen Shape-Objekten musst du natürlich an deine Verhältnisse anpassen.
https://www.herber.de/bbs/user/127883.xlsm
Mit freundlichen Grüßen
Dieter
Anzeige
AW: VBA: Diagramm von Excel in Powerpoint kopiern
25.02.2019 10:36:40
Excel
Hallo Dieter
Vielen Dank!
Da ich mehrere Tabellen und Diagrammen haben, sollte die Code nur das Diagramm von ActiveSheet kopieren.
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Diagramm")
Set cho = ws.ChartObjects(1)
hier kommt ein Fehlermeldung, dass die Makro nicht den Objekt unterstützt.
Kann man einfach Druckbereich kopieren...?
Pfad bzw. Dateiname befinden sich im Zellen W1 und W2. Wie kann man das in die Code schreiben?
Vielen lieben Dank für deine Hilfe.
Ro
Robert
AW: VBA: Diagramm von Excel in Powerpoint kopiern
25.02.2019 21:31:39
Excel
Hallo Ro,
wenn du den Druckbereich des aktiven Blattes nach PowerPoint übertragen willst, dann kannst du das mit dem folgenden Programm machen:
Sub Druckbereich_nach_PowerPoint()
Dim datei As String
Dim i As Long
Dim objPP As Object 'PowerPoint.Application
Dim objP As Object  'PowerPoint.Presentation
Dim objCL As Object 'PowerPoint.CustomLayout
Dim objS As Object  'PowerPoint.Slide
Dim pfad As String
Dim PrRg As String
Dim sh As Object    'PowerPoint.Shape
Dim ShRg As Object  'PowerPoint.ShapeRange
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Steuerung")
pfad = ws.Range("W1")
datei = ws.Range("W2")
If Dir(pfad & datei) = "" Then
MsgBox pfad & datei & vbNewLine & "existiert nicht"
Exit Sub
End If
Set objPP = CreateObject("PowerPoint.Application")
Set objP = objPP.Presentations.Open(pfad & datei)
Set objS = objP.Slides(2)
' Folie 2 bis auf den Titel leeren
For i = objS.Shapes.Count To 1 Step -1
If objS.Shapes(i).Name  "Titel 1" Then
objS.Shapes(i).Delete
End If
Next i
Set ws = ActiveSheet
PrRg = ws.PageSetup.PrintArea
ws.Range(PrRg).CopyPicture
Set ShRg = objS.Shapes.PasteSpecial(DataType:=0) ' ppPasteDefault = 0
ShRg.Left = 100
ShRg.Top = 100
ShRg.Height = 400
objP.Save
objP.Close
objPP.Quit
End Sub
Pfad und Dateiname werden aus dem ersten Blatt gelesen (Blatt "Steuerung").
https://www.herber.de/bbs/user/127928.xlsm
Mit freundlichen Grüßen
Dieter Klemke
Anzeige
AW: VBA: Diagramm von Excel in Powerpoint kopiern
26.02.2019 22:59:00
Excel
Vielen Lieben Dank...Es hat super funktioniert!!!!

310 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige