Excel in PowerPoint via VBA
11.12.2012 20:57:19
Marion
ich habe einen Button in einer Excel-Datei mit dem ich ein auf dem Tabellenblatt befindliches Diagramm kopiere und in eine Powerpoint-Datei einfüge.
Diese PP-Datei hat ein von mir erstelltes Layout.
Nachdem das Diagramm eingefügt ist, wird noch eine Tabelle (A1:D5) kopiert und in der PP-Datei unter dem Diagramm eingefügt. Die Tabelle hat keinen direkten Bezug zu dem Diagramm also muss auf diesem Weg kopiert werden.
In der PP-Datei habe ich Makros geschrieben um das Diagramm und die Tabelle richtig zu positionieren.
Abhängig von einem angeklickten OptionButton wird dessen "Caption" als Überschrift in der PP-Datei eingefügt (-->"Titel" in meinem Code)
Nun das Problem:
Es funktioniert zwar alles, aber wenn ich das Diagramm oder die Tabelle ändere, wird beim Button-Klick die gleiche Datei nochmals geöffnet.
Ich möchte aber das er das neue Diagramm in die bereits geöffnete PP-Datei auf die nächste Folie einfügt. Dieser Prozess kann öfters vorkommen, d.h. es müste wahrsch. eine Schleife integriert werden?!
Hier mein bisheriger Code:
Sub Excel_nach_PP()
Dim PP As powerpoint.Application
Dim pPres As powerpoint.Presentation
Dim Pfad As String
Dim Dateiname as String
Dim Titel As String
If ActiveSheet.OptionButton1.Value = True Then
Titel = ActiveSheet.OptionButton1.Caption
ElseIf ActiveSheet.OptionButton2.Value = True Then
Titel = ActiveSheet.OptionButton2.Caption
ElseIf ActiveSheet.OptionButton3.Value = True Then
Titel = ActiveSheet.OptionButton3.Caption
End If
Dateiname = Name der PP-Datei
Pfad = Netzwerkpfad auf die leere PP-Datei mit vorgefertigtem Layout
Set PP = CreateObject("PowerPoint.Application")
PP.Visible = True
ActiveSheet.ChartObjects("Diagramm 1").Activate
ActiveChart.ChartArea.Select
ActiveChart.ChartArea.Copy
With PP
.Presentations.Open Pfad, msoTrue
.ActiveWindow.Selection.SlideRange.Shapes("Textfeld 1").Select '=Überschrift in PP-Folie
.ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Text = Titel '=Inhalt Überschrift
.ActiveWindow.Selection.Unselect
.Run Dateiname & "!DiagrammEinfuegen"
End With
PP.Visible = msoTrue
Set pPres = PP.ActivePresentation
Sheets("Mitarbeiter").Range("A1:D5").Copy
PP.Run Dateiname & "!TabelleEinfuegen"
Application.CutCopyMode = False
End Sub
Liebe Grüße
Marion