AW: Mit Collections PowerPoint Folien erstellen
10.11.2012 02:01:57
fcs
Hallo Tobias,
hier ein BeispielMakro zum "Einsammeln" der Chart-Objekte in Excel in eine Collection und anschliessendes Kopieren in eine neue PowerPoint-Präsentation.
Mit entsprechenden Anpassungen kann man auch in eine bereitsvorhanden PP-Datei die Diagramme einfügen.
Gruß
Franz
Option Explicit
'Makro in einem allgemeinen Modul in Excel
System: Windows -Vista, MS - Ofice - 2010
Sub aaatest()
Dim colContainer As Collection
Dim objXl_Workbook As Workbook
Dim chrtBar As ChartObject, iCount As Integer, minRand As Double
Dim objPP_App As Object, objPP_Praes As Object, objPP_Slide As Object, objShape As Object
'Arbeiten mit den nachfolgenden Variablendeklarationen erfordert, dass _
im Excel-VBA-Editor für die Datei mit dem Makro unter Extras--Verweise... _
im Dialog der Verweis auf die "Mirosoft Powerpoint x.x ObejectLibrary" gesetzt wird.
'Dim objShape As PowerPoint.Shape
'Dim objPP_App As PowerPoint.Application
'Dim objPP_Praes As PowerPoint.Presentation
'Dim objPP_Slide As PowerPoint.Slide
Set objXl_Workbook = ActiveWorkbook
Set colContainer = New Collection
With objXl_Workbook
colContainer.Add .Worksheets(1).ChartObjects(1)
colContainer.Add .Worksheets(1).ChartObjects(2)
colContainer.Add .Worksheets(3).ChartObjects(1)
End With
Set objPP_App = VBA.CreateObject("Powerpoint.Application")
objPP_App.Visible = True
Set objPP_Praes = objPP_App.Presentations.Add
For Each chrtBar In colContainer
'neue Folie anfügen
iCount = iCount + 1
objPP_Praes.Slides.Add iCount, 12 '12 = ppLayoutBlank
Set objPP_Slide = objPP_Praes.Slides(iCount)
objPP_Slide.Select
'Diagramm kopieren
chrtBar.Parent.Activate
chrtBar.Parent.Shapes(chrtBar.Name).Select
Selection.Copy
With objPP_App.ActiveWindow
'Fensteransicht in PP korrekt einstellen
.ViewType = ppViewSlide
'Einfügen als verlinktes Diagramm-Object
.View.PasteSpecial DataType:=10, Link:=msoTrue '10 = ppPasteOLEObject
'Einfügen als Diagramm-Object
' .View.PasteSpecial DataType:=0, Link:=msoFalse '0 = ppPasteDefault
'Einfügen als Diagramm-Object
' .View.PasteSpecial DataType:=5, Link:=msoFalse '5 = ppPasteJPG
'Einfügen mit Standardeinstellungen Diagramm-Object
' .View.Paste
'Diagramm in PP ggf. in Größe anpassen und positionieren
Set objShape = objPP_Slide.Shapes(objPP_Slide.Shapes.Count)
minRand = Application.CentimetersToPoints(1.5) '1,5 cm Rand in Folie
With objShape
Select Case .Type
Case 10, 11, 13 'msoLinkedOLEObject, msoLinkedPicture, msoPicture
.LockAspectRatio = msoTrue
.ScaleHeight factor:=Application.WorksheetFunction.Min( _
(objPP_Praes.PageSetup.SlideHeight - 2 * minRand) / .Height, _
(objPP_Praes.PageSetup.SlideWidth - 2 * minRand) / .Width), _
relativetooriginalsize:=msoTrue, fscale:=msoScaleFromMiddle
Case 3 'msoChart
.LockAspectRatio = msoTrue
.Height = Application.WorksheetFunction.Min( _
(objPP_Praes.PageSetup.SlideHeight - 2 * minRand) / .Height, _
(objPP_Praes.PageSetup.SlideWidth - 2 * minRand) / .Width) * .Height
.Top = (objPP_Praes.PageSetup.SlideHeight - .Height) / 2
.Left = (objPP_Praes.PageSetup.SlideWidth - .Width) / 2
End Select
End With
End With
Next
End Sub