Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA PasteSpecial - Titel verschiebt sich

Forumthread: VBA PasteSpecial - Titel verschiebt sich

VBA PasteSpecial - Titel verschiebt sich
19.08.2014 14:02:28
Marcus
Hallo Zusammen!
Ich möchte Diagramme einer Excel-Datei per Makro in eine vorgefertigte PPT-Präsentation als Metadatei einfügen. Funktioniert soweit auch alles ganz gut, nur ein Problem bekomm ich einfach nich in den Griff. Es verschiebt sich der Titel der Folie, bzw. das Textfeld vergrößert sich, es ist so, als hätte man das Bild in das Titelfeld eingefügt. Manchmal verschieben sich auch die Seitenzahlen.
Hoffe Ihr könnt mir weiterhelfen! Anbei der Code:

Private Sub CommandButton1_Click()
Dim pptApp As Object, pptPres As Object
Dim chtObj As Object, shp As Object, i
Set pptApp = CreateObject("PowerPoint.Application")
Set pptPres = pptApp.Presentations.Open("X:...........pptx")
Sheets("Auswertung").Select
For Each chtObj In ActiveSheet.ChartObjects
chtObj.CopyPicture xlScreen, xlBitmap
Set pptslide = pptPres.Slides(i)
pptslide.Shapes.PasteSpecial DataType:=wdPasteEnhancedMetafile
With pptslide.Shapes(1)
.Top = 100
.Left = 5
.Height = 383
.Width = 709.5
End With
If i = 20 Then
Exit For
End If
Next
pptApp.Visible = True
End Sub

Vielen Dank!
Marcus

Anzeige

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA PasteSpecial - Titel verschiebt sich
19.08.2014 15:17:21
fcs
Hallo Marcus,
Hauptproblem war der gewählte DataType für das einfügen. Der muss kompatibel zur kopierten Quelle sein.
Außerdem fehlter das Setzen und Hochzählen des Slidezählers.
Gruß
Franz
Sub CommandButton1_Click()
Dim chtObj As Object, i
Dim pptApp As Object  ' PowerPoint.Application
Dim pptPres As Object ' PowerPoint.Presentation
Dim ppShp As Object ' PowerPoint.Shap
Dim pptSlide As Object ' PowerPoint.Slide
Set pptApp = CreateObject("PowerPoint.Application")
Set pptPres = pptApp.Presentations.Open("D:\Test\MeinePP.pptx", _
ReadOnly:=msoTrue) ', untitled:=True)
Sheets("Auswertung").Select
i = 1 'Startzähler für Slides setzen
For Each chtObj In ActiveSheet.ChartObjects
chtObj.CopyPicture xlScreen, xlBitmap
Set pptSlide = pptPres.Slides(i)
'      pptslide.Shapes.PasteSpecial DataType:=0 ' 0 = ppPasteDefault
pptSlide.Shapes.PasteSpecial DataType:=1 ' 1 = ppPasteBitmap
Set ppShp = pptSlide.Shapes(pptSlide.Shapes.Count)
With ppShp
.Top = 100
.Left = 5
.Height = 383
.Width = 709.5
End With
i = i + 1
If i = 20 Then
Exit For
End If
Next
pptApp.Visible = True
End Sub

Anzeige
AW: VBA PasteSpecial - Titel verschiebt sich
19.08.2014 15:58:10
Marcus
Hallo Franz,
zunächst einmal vielen herzlichen Dank! Das benannte Problem tritt nicht mehr auf, aber leider leidet die Qualität der Diagramme bzw. der Bilder massiv unter dem neuen Format. Gibt es Lösung die es dennoch erlaubt die Diagramme als Metadatei einzufügen?
VG Marcus

Anzeige
AW: VBA PasteSpecial - Titel verschiebt sich
19.08.2014 17:27:54
fcs
Hallo Marcus,
wenn man das Chartobject "einfach" nur kopiert, dann hat man mehr Einfügeoptionen für den DataType, von denen einige auch eine bessere Grafikqualität liefern..
Gruß
Franz
Sub CommandButton1_Click()
Dim chtObj As Object, i
Dim pptApp As Object  ' PowerPoint.Application
Dim pptPres As Object ' PowerPoint.Presentation
Dim ppShp As Object ' PowerPoint.Shap
Dim pptSlide As Object ' PowerPoint.Slide
Set pptApp = CreateObject("PowerPoint.Application")
Set pptPres = pptApp.Presentations.Open("D:\Test\MeinePP.pptx", _
ReadOnly:=msoTrue) ', untitled:=True)
Sheets("Auswertung").Select
i = 1 'Startzähler für Slides setzen
For Each chtObj In ActiveSheet.ChartObjects
chtObj.Copy
Set pptSlide = pptPres.Slides(i)
pptSlide.Shapes.PasteSpecial DataType:=2 ' 2 = ppPasteEnhancedMetafile
'      pptSlide.Shapes.PasteSpecial DataType:=3 ' 3 = ppPasteMetafilePicture
'      pptSlide.Shapes.PasteSpecial DataType:=0 ' 0 = ppPasteDefault - fügt Diagramm-Objekt ein
'      pptSlide.Shapes.PasteSpecial DataType:=1 ' 1 = ppPasteBitmap - miese Qualität
'      pptSlide.Shapes.PasteSpecial DataType:=5 ' 5 = ppPasteJPG - miese Qualität
Set ppShp = pptSlide.Shapes(pptSlide.Shapes.Count)
With ppShp
.Top = 100
.Left = 5
.Height = 383
.Width = 709.5
End With
i = i + 1
If i = 20 Then
Exit For
End If
Next
pptApp.Visible = True
End Sub

Anzeige
AW: VBA PasteSpecial - Titel verschiebt sich
19.08.2014 18:05:41
Marcus
Hallo Franz,
wow Danke, Du bist großartig! Jetzt funktioniert alles einwandfrei. Sehe ich das richtig, dass es daran lag, das ich "CopyPicture" statt nur "Copy" zum füllen den Zwischenablage genommen hat und das für die Metadatei nich passte?

AW: VBA PasteSpecial - Titel verschiebt sich
20.08.2014 09:45:52
fcs
Hallo Marcus,
Sehe ich das richtig, dass es daran lag, das ich "CopyPicture" statt nur "Copy" zum füllen den Zwischenablage genommen hat und das für die Metadatei nich passte?
Ja!
Mit "Copy" wird in Excel die normale Kopieraktion für das vorgegebene Objekt durchgeführt. Damit stehen dann beim Einfügen in der Zielanwendung je nach deren Fähigkeiten verschiedenste Formate zur Verfügung. In PP dann von Text über verschiedene Grafikformate bis zu verknüpften Objekten.
Mit CopyPicture wird in Excel eine Grafik etwa mit Screenshot-Qualität in die Zwischenablage übernommen.
Gruß
Franz
Anzeige
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige