Excel-Diagramm in neue PP-Folie

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 'Tabelle einfügen Set pPres = PP.ActivePresentation Sheets("Mitarbeiter").Range("A1:D5").Copy PP.Run Dateiname & "!TabelleEinfuegen" Application.CutCopyMode = False End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Marion,
du hättest deine Frage nicht erneut stellen müssen. Es hätte gereicht, wenn du bei deiner Nachfrage bei der vorherigen Frage die entsprechende Checkbox markiert hättest, dass die Frage noch offen bleiben soll.
Eine Basis-Idee zur Lösung deines Problems hätte ich schon.
Im Excelmakro müßte man eine Inputbox einbauen, um festzulegen, ob man eine neue PP-Datei erstellen will oder in einer bestehenden PP-Datei eine Folie anfügen.
Entsprechend muss dann der weitere Ablauf gesteuert werden.
Ich hab mal versucht das so umsetzen.
Leider hab ich es nicht geschafft, per VBA von Excel aus so auf eine in PP schon geöffnete Präsentation zuzugreifen, dass die PP-Makros korrekt gestartet werden.
Ich hab es nur hinbekommen, wenn ich alle Makrofunktionen inklusive des Einfügens und Positionierens von Diagramm/Tabellenausschnitt direkt im Excelmakro integriere. Die PP-Datei, an die eine neue Folie angehängt werden soll, muss vor dem Starten des Makros geschlossen sein, sie wird im Makro in einem Dialogfenster ausgewählt.
Im Makro muss du ggf. die Zeilen anpassen, in denen Diagramm/Tabellenausschnitt in PP eingefügt werden und natürlich den Pfad der Mustervorlage und die Positionen, an die das Diagramm/der Tabellenausschnitt auf der Folie verschoben werden sollen.
Gruß
Franz

Option Explicit
'Hinweis
'In Excel muss im VBA-Editor für die Datei unter Extras--Verweise der Verweis auf die
' Microsoft Powerpoint x.y ObjectLibrary
'aktiviert werden.
Sub Excel_nach_PP_neu()
Dim PP As PowerPoint.Application
Dim Pfad As String
Dim objSlide As PowerPoint.Slide
Dim objShape As PowerPoint.Shape
Dim objPraes As PowerPoint.Presentation
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
Select Case Application.InputBox(Prompt:="1 = neue PP-Datei erstellen" & vbLf _
& "2 = Diagramm auf neuer Folie in PP-Päsentation anfügen", _
Title:="Diagramm nach PowerPoint kopieren", _
Default:=2, Type:=1)
Case 0
'do nothing
GoTo Beenden
Case 1
'Diagramm in Mustervorlage kopieren
'Netzwerkpfad auf die leere PP-Datei mit vorgefertigtem Layout"
Pfad = "C:\Users\Public\Test\PP_Test\myPP_Muster.pptm"          'anpassen !!!
Set PP = CreateObject("PowerPoint.Application")
PP.Visible = True
With PP
Set objPraes = .Presentations.Open(Pfad, msoTrue)
End With
PP.Visible = msoTrue
Case 2
'Diagramm  in vorhandener PP-Datei in neuer Folie einfügen
With Application.FileDialog(msoFileDialogOpen)
.InitialFileName = "*.ppt*"
.Title = "Bitte PowerPoint-Datei auswählen, die bearbeitet werden soll"
If .Show = -1 Then
Pfad = .SelectedItems(1)
Else
GoTo Beenden
End If
End With
Set PP = CreateObject("PowerPoint.Application")
PP.Visible = True
With PP
Set objPraes = .Presentations.Open(Pfad)
End With
PP.Visible = msoTrue
'Letzte Folie duplizieren
Set objSlide = objPraes.Slides(objPraes.Slides.Count)
objSlide.Duplicate
Set objSlide = objPraes.Slides(objPraes.Slides.Count)
'in kopierter Folie zuletzt eingefügte Shapes löschen (Tabellenbereich _
und Diagrammbereich)
With objSlide
Set objShape = .Shapes(.Shapes.Count)
objShape.Delete
Set objShape = .Shapes(.Shapes.Count)
objShape.Delete
End With
Case Else
MsgBox "Unzulässige Option ausgewählt", vbInformation + vbOKOnly, _
"Diagramm nach PowerPoint kopieren"
GoTo Beenden
End Select
'Letzte Folie in Präsentation selektieren
Set objSlide = objPraes.Slides(objPraes.Slides.Count)
objSlide.Select
'Diagrammüberschrift an Option anpassen
Set objShape = objSlide.Shapes("Textfeld 1")
objShape.TextFrame.TextRange.Text = Titel '=Inhalt Überschrift
'Diagrammbereich kopieren und positionieren
ActiveSheet.ChartObjects("Diagramm 1").Activate
ActiveChart.ChartArea.Select
ActiveChart.ChartArea.Copy
PP.ActiveWindow.View.PasteSpecial DataType:=ppPasteOLEObject, Link:=msoFalse
With objSlide
Set objShape = .Shapes(.Shapes.Count)
With objShape
.Top = 100
.Left = 50
End With
End With
'Tabellenbereich kopieren und positionieren
Sheets("Mitarbeiter").Range("A1:D5").Copy
PP.ActiveWindow.View.PasteSpecial DataType:=ppPasteOLEObject, Link:=msoFalse
Set objSlide = objPraes.Slides(objPraes.Slides.Count)
With objSlide
Set objShape = .Shapes(.Shapes.Count)
With objShape
.Top = 400
.Left = 50
End With
End With
Application.CutCopyMode = False
Beenden:
Set PP = Nothing: Set objPraes = Nothing
Set objSlide = Nothing: Set objShape = Nothing
End Sub

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Excel-Diagramm in neue PP-Folie

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread