image copy to clipboard

Guten Tag liebe Excelprofis,
ich habe eine kurze Frage an euch, meine eigentlich schon relativ weit zu sein und hoffe euch daher nicht all zu lang zu beschäftigen.
Ich möchte gerne ein Objekt aus einer Powerpointpräsentation als Grafik in eine andere einfügen.
Händisch ist das recht fix erledigt:
Objekt aus Vorlage Auswählen --> rechtsklick --> kopieren --> Folie in anderer Präsi auswählen --> rechtsklick --> Einfügeoptionen --> Grafik --> Fertig
dieser Schritt soll jedoch häufiger ausgeführt werden und muss deswegen automatisch erfolgen.
mein erstes Grundgerüst für das Makro ist folgendes:


ppvor.Slides(3).SlideRange.Shapes("Name des Objektes").Select
Selection.Copy
pprep.Slides(3)
Selection.Pastespecial

Es ist ein Teil eines größeren Makros und der Rest funktioniert auch.
Dabei erfolgen vorher bereits einige Berechnungen im Excel, welche dann in pprep eingetragen werden
pprep ist dabei die Präsentation in die aus Excel Daten einfließen (funktioniert auch).
ppvor ist die pptx in welcher sich Objekte befinden, welche mit Qlikview verbunden sind.
Als Objekte würden sie meine fertige Präsentation jedoch extrem langsam machen und da ich in der finalen Phase auch nicht mehr mit ihnen arbeiten muss, reichen mir die jpgs.
Ich würde mich sehr freuen, wenn mir jemand von euch diesbezüglich helfen könnte, da ich bei meiner recherche nur auf das Kopieren einer range aus Excel in PPT gestoßen bin.


Range("A1:Q11").Copy
pprep.Slides(2).Shapes.PasteSpecial DataType:=ppPasteOLEObject, Link:=msoFalse

Das ist bereits Bestandteil meines Werks, lässt sich jedoch nicht so einfach anpassen
MfG Felix

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Felix,
für einen kopierten Excelzellbereich funktionieren in Verbindung mit SlideObjekt.Shapes.PasteSpecial nur die folgenden Werte für DataType:

       1  = ppPasteBitmap _
2  = ppPasteEnhancedMetafile _
3  = ppPasteMetafilePicture _
10 = ppPasteOLEObject  - hier kann lngLink auch auf msoTrue gesetzt werden _
9  = ppPasteRTF _
7  = ppPasteText

Ich hatte allerdings beim Testen Probleme mit der Position und ggf. Größe der eingefügten Grafik in der PP-Folie. Ich mir deshalb eine Subroutine gebaut, die die eingefügte Grafik zusätzlich positioniert und ggf. in der Größe anpasst.
Nachfolgend mein Excel-Test-Makro.
Gruß
Franz

'Erstellt unter Excel 2010, PowerPoint 2010
'Im Excel VBA-Editor muss unter Extras-->Verweise für die Datei der Verweis auf die
'Microsoft PowerPint y.y Object Library
'aktiviert werden
Sub aaTest()
Dim objAppPP As PowerPoint.Application
Dim pprep As PowerPoint.Presentation
Set objAppPP = New PowerPoint.Application
'PP-Vorlage als Kopie sichtbar öffnen
Set pprep = objAppPP.Presentations.Open( _
Filename:="C:\Users\Public\Test\PP_Test\myPP_Muster.potx", _
untitled:=True, withwindow:=msoTrue)
'Excelbereich nach Folie 2 kopieren
Call ExcelRange_nach_PP(objSlide:=pprep.Slides(2), _
objRange:=ActiveSheet.Range("A1:Q11"), sngScale:=0.95)
Application.CutCopyMode = False
objAppPP.Activate
With objAppPP.FileDialog(msoFileDialogSaveAs)
.Show
End With
End Sub
Sub ExcelRange_nach_PP(objSlide As PowerPoint.Slide, objRange As Range, _
Optional ByVal dblTop As Double = -1, Optional ByVal dblLeft As Double = -1, _
Optional ByVal sngScale As Single = 1, _
Optional ByVal lngPasteFormat As Long = 2, _
Optional ByVal lngLink As Long = msoFalse)
'Kopieren eines Zellbereichs von Excel in eine PowerPoint-Folie
'Standardmäßig -wenn dblTop und/oder dblLeft nicht angegeben sind- wird _
die Grafik mittig auf der Folie eingefügt
'objSlide = PowerPoint.Slide auf de, der Excel-Zellbereich eingefügt werden soll
'objRange = Excel-Zellbereich, der kopiert werden soll
'mögliche Werte für lngPasteFormat _
1  = ppPasteBitmap _
2  = ppPasteEnhancedMetafile _
3  = ppPasteMetafilePicture _
10 = ppPasteOLEObject  - hier kann lngLink auch auf msoTrue gesetzt werden _
9  = ppPasteRTF _
7  = ppPasteText
'Die folgenden Einfügeoptionen funktionieren mit einem kopierten Excel-Zellbereich _
in Verbindung mit SlideObject.Shapes.PasteSpecial nicht _
0  = ppPasteDefault 'Standardwert. _
4  = ppPasteGIF _
8  = ppPasteHTML _
5  = ppPasteJPG _
6  = ppPastePNG _
11 = ppPasteShape
Dim objShape As PowerPoint.Shape
Dim dblSlideHeight As Double, dblSlideWidth As Double
objRange.Copy
objSlide.Shapes.PasteSpecial DataType:=lngPasteFormat, Link:=lngLink
With objSlide
dblSlideHeight = .Parent.PageSetup.SlideHeight
dblSlideWidth = .Parent.PageSetup.SlideWidth
Set objShape = .Shapes(.Shapes.Count)
With objShape
.LockAspectRatio = msoTrue
If .Height > dblSlideHeight Or .Width > dblSlideWidth Then
'Größe anpassen Abmessung(en) größer als die der Folie
If .Height > dblSlideHeight Then
.Height = dblSlideHeight
End If
If .Width > dblSlideWidth Then
.Width = dblSlideWidth
End If
End If
If dblTop = -1 Then
.Top = (objSlide.Parent.PageSetup.SlideHeight - .Height) / 2
Else
.Top = dblTop
End If
If dblLeft = -1 Then
.Left = (objSlide.Parent.PageSetup.SlideWidth - .Width) / 2
Else
.Left = dblTop
End If
If sngScale  1 Then
.ScaleWidth Factor:=sngScale, relativetooriginalsize:=msoFalse, _
fscale:=msoScaleFromMiddle
End If
End With
End With
End Sub

'Charts als image in report einfügen ppApp.Activate ppvor.Slides(3).Select ppApp.ActiveWindow.Selection.SlideRange.Shapes("dispersion241").Select Selection.Copy pprep.Slides(3).Select ppApp.ActiveWindow.Selection.SlideRange.Shapes("dispersion241").Select ppApp.ActiveWindow.Selection.TextRange.PasteSpecial ppPasteBitmap

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

image copy to clipboard

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread