AW: Kopie editierbare Tabelle Excel -> Powerpoint
17.12.2013 10:01:56
fcs
Hallo Björn,
ich hab nochmals in den Tiefen von PowerPoint und VBA weiter gesucht und probiert.
Dabei hab ich herausgefunden, dass Paste in den verschiedenen PP-Ansichten und je nach aktivem Objekt unterschiedlich/nicht funktioniert.
Beim Kopieren von Excel nach PP scheint Paste wie gewünscht zu funktionieren, wenn nur die einzelnen Folien angezeigt werden.
Deshalb muss man im Makro die PP-Ansicht entsprechend einstellen.
Kopiert man einen Excel-Bereich inklusive eingebettetem Diagramm, dann werden die Zellen in PP editierbar eingefügt, die Diagramme behalten jedoch ihren Link zur Datenquelle. Diese Links muss man dann ggf. noch entfernen.
Nachfolgend ein Beispielmakro. Die Muster-PP-Präsentation hat bei mir eine Titelfolie und eine 2. Folie (leer außer den in der Masterfolie hinterlegten Elementen).
Gruß
Franz
'Erstellt unter MS Office 2010 professional - Excel 2010, PowerPoint 2010
Option Explicit
Sub Zellbereiche_Nach_PowerPoint()
'Kopiert Zellbereiche in eine PowerPoint-Präsentation Stand: 2013-12-17
'Im Excel VBA-Editor muss unter Extras der Verweis auf die _
Microsoft PowerPoint Object Library gesetzt sein _
oder alle PP-Objekte müssen als Object deklariert werden
Dim PP As PowerPoint.Application
Dim PP_Datei As PowerPoint.Presentation
Dim PP_Folie As PowerPoint.Slide
Dim PP_Shape As PowerPoint.Shape
Dim xl_Range As Range
Dim bool_Erste As Boolean
Dim intRange As Integer
'PP-Datei in die die Zellbereiche in jeweils eine Folie kopiert werden sollen
Const strPP_Datei As String = "C:\Users\Public\Test\Meine Testpräsentation.pptx" 'anpassen!
'Powerpoint-Vorlage schreibgeschützt öffnen
Set PP = CreateObject("Powerpoint.Application")
With PP
.Visible = True
Set PP_Datei = .Presentations.Open( _
Filename:=strPP_Datei, _
ReadOnly:=True)
End With
PP.ActiveWindow.ViewType = 1 'ppViewSlide 'wichtig, nur in dieser Ansicht funktioniert _
Paste sauber
bool_Erste = True
For intRange = 1 To 2 '2 = ANzahl der zu kopierenden Zellbereiche
If bool_Erste = True Then
'bei erstem Kopieren keine Folie anfügen
bool_Erste = False
Else
'neue Folie anfügen mit Layoutvorlage der 2. Folie
With PP_Datei
.Slides.AddSlide Index:=.Slides.Count + 1, pcustomlayout:=.Slides(2).CustomLayout
End With
End If
'Letzte Folie setzen
Set PP_Folie = PP_Datei.Slides(PP_Datei.Slides.Count)
Select Case intRange
Case 1
Set xl_Range = ActiveWorkbook.Worksheets("Tabelle1").Range("A1:G21")
Case 2
Set xl_Range = ActiveWorkbook.Worksheets("Tabelle2").Range("A1:G21")
End Select
'Zellbereich in Excel kopieren
xl_Range.Copy
'kopierten Bereich in PP einfügen
PP_Folie.Select
PP.ActiveWindow.View.Paste
Next
'bei allen Diagrammobjekten den Link zur Datenquelle entfernen
On Error Resume Next
For Each PP_Folie In PP_Datei.Slides
For Each PP_Shape In PP_Folie.Shapes
If PP_Shape.Type = 3 Then '3 = msoChart
PP_Shape.LinkFormat.BreakLink
End If
Next
Next
PP.ActiveWindow.ViewType = 9 'ppViewNormal
PP.WindowState = 3 'ppWindowMaximized
Beenden:
Set PP = Nothing: Set PP_Datei = Nothing: Set PP_Folie = Nothing: Set PP_Shape = Nothing
End Sub