Office: Diagramme per Makro ins Powerpoint kopieren

tg6300 · 31. August 2008

Hallo,

ich versuche mit einem Makro aus einem Excelfile, welches Diagramme ( 4 Stück) enthält, diese in eine Powerpoint-Datei zu kopieren und jedes Diagramm soll auf eine neue Folie abgelegt werden.
Der folgende Code bleibt immer wieder an der markierten Stelle stehen und im geöffneten Powerpoint steht: "Erste Folie durch klicken hinzufügen" und im VBA-Fenster erscheint ein Laufzeitfehler: "Slides.Add : Invalid enumeration value".
Wie kann man diese Meldung umgehen und gleich eine leere Folie erzeugen.
Der Code ist jetzt natürlich nur für ein Diagramm, aber ich brauch vier Diagramme übertragen. Habt ihr vielleich einen Tipp für mich?

Code:

Sub DiagrammeKopieren()

Dim oPP As Object
Dim oPres As Object
Dim ppLayoutTitle
Dim ppLayoutBlank As Variant

Set oPP = CreateObject("PowerPoint.Application")

Sheets("Diagramm1").Select
ActiveChart.ChartArea.Copy

oPP.Visible = True
Set oPres = oPP.Presentations.Add(True)
oPres.Slides.Add 1, ppLayoutBlank

:)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

smi · 2. September 2008

Hallo Thomas,

versuche es mal mit folgender Zeile:
Code:

oPres.Slides.Add(1, 11)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Bei mir hat es funktioniert.

Gruß smi

smi · 2. September 2008

Hallo Thomas,

hier noch ein Code, mit dem man 4 Tabellen in einer Schleife durchlaufen kann:
Code:

Sub Export_PowerPoint()
On Error GoTo Fehler
Set ppApp = CreateObject("Powerpoint.Application")
ppApp.Visible = True
Set ppFile = ppApp.presentations.Add(True)
For intCounter = 4 To 1 Step -1
Sheets(intCounter).Select
ActiveChart.ChartArea.Copy
ppFile.Slides.Add(1, 11).Select
ppApp.ActiveWindow.View.Paste
Next intCounter
Ende:
Set ppApp = Nothing
Exit Sub
Fehler:
MsgBox "Fehler beim Export nach PowerPoint.", vbCritical
Resume Ende
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Gruß smi

tg6300 · 2. September 2008

Hallo,

da bringt er bei mir:

Fehler beim Kompilieren: Erwartet:=

Sagt Dir das etwas?

Danke & Gruß

Thomas

smi · 2. September 2008

Hallo,
bei mir bekomme ich keine Hinweis. Habe Dir eine Muster-Datei mal angehängt. Sie funktioniert be mir problemlos.
Grüße smi

tg6300 · 2. September 2008

Hallo smi,

danke für Deine schnelle Hilfe. Hab Deine Beispiel-Datei getestet und sie funktioniert einwandfrei. Eine Frage habe ich noch:

Wie kann ich die Diagramm-Blätter direkt mit dem Namen ansprechen, da sie in meinem Excel-File zwischen "normalen" Tabellen angeordnet sind und nicht gleich vorn stehen?

Danke & Gruß

Thomas

smi · 3. September 2008

Hallo Thomas,

ich würde den Code folgendermaßen um einen Array erweitern, der auch noch beliebig ausgebaut werden kann. Dieser Array wird dann in der Schleife abgearbeitet:
Code:

Sub Export_PowerPoint()
On Error GoTo Fehler
Dim arrDia() As String
ReDim arrDia(4)
arrDia(1) = "Diagramm1"
arrDia(2) = "Diagramm1 (2)"
arrDia(3) = "Diagramm1 (3)"
arrDia(4) = "Diagramm1 (4)"
Set ppApp = CreateObject("Powerpoint.Application")
ppApp.Visible = True
Set ppFile = ppApp.presentations.Add(True)
For intCounter = 4 To 1 Step -1
Sheets(arrDia(intCounter)).Select
ActiveChart.ChartArea.Copy
ppFile.Slides.Add(1, 11).Select
ppApp.ActiveWindow.View.Paste
Next intCounter
Ende:
Set ppApp = Nothing
Exit Sub
Fehler:
MsgBox "Fehler beim Export nach PowerPoint.", vbCritical
Resume Ende
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Grüße smi

tg6300 · 3. September 2008

Hallo smi,

es funktioniert jetzt genauso wie es soll. Anfangs hakte es noch etwas, aber nachdem ich aus den Zeilen 6; 7 und 8 die hintere Klammer mit der 2,3,4 rausgenommen hatte, klappte es wunderbar.

Danke für die geduldige Unterstützung.

Gruß,
Thomas

tg6300 · 3. September 2008

Hallo smi,

ich muss dich leider nochmal belästigen. Wie kann ich Powerpoint mitteilen, das nicht ein leeres Dokument, sondern eine Vorlage geladen wird. Dann soll es zb. ab dem zweiten Blatt eingefügt werden.

Außerdem sollten die Bilder als Windows-Metadatei eingefügt werden.

Danke im Vorraus.

Gruß, Thomas

tg6300 · 3. September 2008

Hallo smi,

hab etwas weiter experimentiert und jetzt wird mit dem folgenden Code auch die Vorlage geladen, aber leider wird sie gleich wieder überschrieben.
Wie kann ich das machen, das von der Vorlage das erste und letzte Blatt erhalten bleibt?

Code:

Sub Export_PowerPoint()
On Error GoTo Fehler
Dim arrDia() As String
ReDim arrDia(4)
arrDia(1) = "Diagramm1"
arrDia(2) = "Diagramm2"
arrDia(3) = "Diagramm3"
arrDia(4) = "Diagramm4"

Set ppApp = CreateObject("Powerpoint.Application")

With ppApp 'neu
.Visible = True
.Activate
.Presentations.Open "\\Server\Share\Template.pot"
End With

Set ppFile = ppApp.Presentations.Add(True)
For intCounter = 4 To 1 Step -1
Sheets(arrDia(intCounter)).Select
ActiveChart.ChartArea.Copy
ppFile.Slides.Add(1, 11).Select
ppApp.ActiveWindow.View.Paste
Next intCounter
Ende:
Set ppApp = Nothing
Exit Sub
Fehler:
MsgBox "Fehler beim Export nach PowerPoint.", vbCritical
Resume Ende
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Danke & Gruß

Thomas

smi · 6. September 2008

Hallo Thomas,

sorry, habe mich für einige Tage ausgeklinkt.
Ohne es jetzt selbst getestet zu haben müsste es folgendermaßen funktionieren (siehe Kommentare im Code):

Code:

Sub Export_PowerPoint()
On Error GoTo Fehler
Dim arrDia() As String
ReDim arrDia(4)
arrDia(1) = "Diagramm1"
arrDia(2) = "Diagramm2"
arrDia(3) = "Diagramm3"
arrDia(4) = "Diagramm4"

Set ppApp = CreateObject("Powerpoint.Application")

With ppApp 'neu
.Visible = True
.Activate
' das Öffnen erfolgt erst später, deshalb hier löschen
' .Presentations.Open "\\Server\Share\Template.pot"
End With

' hier erfolgt jetzt das Öffnen
Set ppFile = ppApp.Presentations.Open("\\Server\Share\Template.pot")
For intCounter = 4 To 1 Step -1
Sheets(arrDia(intCounter)).Select
ActiveChart.ChartArea.Copy
' Soll einen neue Folie erst nach der 1. eingefügt werden, einfach in nächster Zeile von 1 auf 2 hochsetzen
ppFile.Slides.Add(2, 11).Select
ppApp.ActiveWindow.View.Paste
Next intCounter
Ende:
Set ppApp = Nothing
Exit Sub
Fehler:
MsgBox "Fehler beim Export nach PowerPoint.", vbCritical
Resume Ende
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Gruß smi

Office: Diagramme per Makro ins Powerpoint kopieren

Diagramme per Makro ins Powerpoint kopieren

Diagramme per Makro ins Powerpoint kopieren

Diagramme per Makro ins Powerpoint kopieren

Diagramme per Makro ins Powerpoint kopieren

Diagramme per Makro ins Powerpoint kopieren - Similar Threads - Diagramme Makro Powerpoint

Diagramm mit Makro erstellen und formatieren

Dynamische Breite eines dynamischen Diagramms

Makro zum Zelleninhalt löschen und Laufzeitfehler dank Diagramm

Diagramm das mit VBA Makro erstellt wurde Skalierung aus Spalte übernehmen

Diagramm über Werteliste per Makro erstellen

Diagramme in Powerpoint aus Access - Daten erstellen

Makro um automatisch Diagramme zu erzeugen