AW: Bild aus Excel in PPT kopieren
19.11.2009 23:59:13
fcs
Hallo Matti,
das folgende Makro hab ich unter PP 2007 erstellt. Funktion unter PP 2003 ?
Gruß
Franz
'PowerPoint - Makro
'Erstellt mit PowerPoint 2007 / Excel 2007
Sub GetExcelGrafik()
'Für Funktion des Makros muss in PowerPoint im VBA-Editor der Verweis auf die _
Microsoft Excel x.y Object Library _
gesetzt werden.
Dim xlWB As Excel.Workbook, xlDiagramm As Excel.Chart
Dim ppPres As PowerPoint.Presentation, ppSlide As PowerPoint.Slide
Dim strExceldatei As String, objShape As PowerPoint.Shape
Set ppPres = ActivePresentation
Set ppSlide = ppPres.Slides(2) 'Nummer der Folie in die Exceldiagramm eingefügt _
werden soll
'Name der Excel-Datei
strExceldatei = "C:\Users\Public\Test\ExcelDatei.xls"
'Exceldatei öffnen
Set xlWB = Excel.Workbooks.Open(FileName:=strExceldatei, ReadOnly:=True)
'Diagramm ist in Excel auf einem sparaten Blatt
' Set xlDiagramm = xlWB.Charts("Diagramm1")
'oder Diagramm ist in Excel auf einem Tabellenblatt eingebettet
Set xlDiagramm = xlWB.Worksheets("Tabelle1").ChartObjects(1).Chart
xlDiagramm.ChartArea.Copy
ppSlide.Select
ActiveWindow.ViewType = ppViewSlide
'Einfügen als Excelobjekt ohne Verknüpfung
' ActiveWindow.View.PasteSpecial DataType:=ppPasteOLEObject, Displayasicon:=msoFalse, _
link:=msoFalse
'Einfügen als Grafik
ActiveWindow.View.PasteSpecial DataType:=ppPasteGIF
'Exceldatei wieder schliessen
xlWB.Close savechanges:=False
Set xlDiagramm = Nothing
Set xlWB = Nothing
'Eingefügtes Shape formatieren
Set objShape = ppSlide.Shapes(ppSlide.Shapes.Count)
'Größe des Diagramms anpassen
With objShape
.LockAspectRatio = msoTrue
.ScaleHeight Factor:=1.2, relativetooriginalsize:=msoTrue, _
fscale:=msoScaleFromMiddle
End With
Set objShape = Nothing
Set ppSlide = Nothing
Set ppPres = Nothing
End Sub