Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1384to1388
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Von aktivem Powerpoint auf Excel zugreifen

Von aktivem Powerpoint auf Excel zugreifen
06.10.2014 10:10:01
Paddy_P
Hallo zusammen,
ich habe ein Problem, mit dem ich mich schon mehrere Wochen beschäftige.
Ich habe ein Programm geschrieben, bei dem ich von Excel aus, eine Powerpoint Präsentation öffne, befülle und anpasse. Nachdem die wichtigsten Daten vorhanden sind möchte ich als nächsten Schritt wieder auf das Excel-File zugreifen und zwei Tabellen kopieren.
Im Moment scheitere ich daran, dass auf Excel richtig zugegriffen wird.
Der Code ist bisher so:
Function TabellenPPTeinfuegen()
Dim msE As Object
Dim wsE As Worksheet
Set msE = GetObject(, "Excel.Application")
Set wsE = msE.ActiveWorkbook.Sheets("Data")
If wsE Is ActiveSheet Then
msE.ActiveWorkbook.Range("A5:M6").Copy
pptPres.Slides(4).Shapes.Paste
End If
End Function

Wenn ich den Code schrittweise durchlaufen lasse, dann wird anscheinend die If-Frage als false gewertet.
Ich hoffe mir kann irgendjemand helfen?

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Von aktivem Powerpoint auf Excel zugreifen
06.10.2014 10:25:14
Martin
Hallo Paddy_P,
das sind meine beiden Vorschläge:
Entweder so:
Sub TabellenPPTeinfuegen()
Dim msE As Object
Set msE = GetObject(, "Excel.Application")
msE.ActiveWorkbook.Sheets("Data").Range("A5:M6").Copy
pptPres.Slides(4).Shapes.Paste
End Sub
oder so:
Sub TabellenPPTeinfuegen()
Dim msE As Object
Dim wsE As Worksheet
Set msE = GetObject(, "Excel.Application")
Set wsE = msE.ActiveWorkbook.Sheets("Data")
If wsE.Name = ActiveSheet.Name Then
msE.ActiveWorkbook.Range("A5:M6").Copy
pptPres.Slides(4).Shapes.Paste
End If
End Sub
Viele Grüße
Martin

Anzeige
...beste Lösung
06.10.2014 10:33:19
Martin
Paddy_P,
ich habe den Code nochmals optimiert, du musst nur noch den Dateinamen der Excel-Datei korrekt eintragen. Jetzt ist es absolut irrelevant, ob die Excel-Mappe oder das Tabellenblatt "Data" aktiv sind. Es werden trotzdem die richtigen Zellen kopiert:
Sub TabellenPPTeinfuegen()
Dim msE As Object
Dim wbk As Workbook
Set msE = GetObject(, "Excel.Application")
For Each wbk In msE.Workbooks
If wbk.Name = "Mappe1.xlsx" Then 'Dateinamen anpassen!!!
wbk.Sheets("Data").Range("A5:M6").Copy
pptPres.Slides(4).Shapes.Paste
Exit For
End If
Next
End Sub
Viele Grüße
Martin

Anzeige
AW: Von aktivem Powerpoint auf Excel zugreifen
06.10.2014 10:41:41
Paddy_P
Danke,
generell muss ich den Unteren Code verweden, da ich mehrere Worksheets habe und der User später automatisch die Richtigen Tabellen erhält...
Der Vorschlag mit der Workbook-Abfrage geht nicht, da das Excelfile für jede neue Aufgabe umbenannt wird (so ne Art Datenbank der Übersicht wegen)
Also die Abfrage der If-Schleife funktioniert jetzt.
Jedoch bekomm ich beim Argument, was kopiert werden soll (msE.ActiveWorkbook.Range), nen Laufzeitfehler 438 (Objekt unterstützt die Eigenschaft oder Methode nicht).
Irgendwie komm ich mit den Objekten nicht so wirklich zurecht...

Anzeige
AW: Von aktivem Powerpoint auf Excel zugreifen
06.10.2014 11:36:51
Martin
Hallo Paddy_P,
da habe ich nicht aufgepasst, so sollte es aber klappen:
Sub TabellenPPTeinfuegen()
Dim msE As Object
Dim wsE As Worksheet
Set msE = GetObject(, "Excel.Application")
Set wsE = msE.ActiveWorkbook.Sheets("Data")
If wsE.Name = ActiveSheet.Name Then
wsE.Range("A5:M6").Copy
pptPres.Slides(4).Shapes.Paste
End If
End Sub
Hinsichtlich des Dateinamens habe ich auch noch einen Vorschlag. Bei folgendem Makro werden alle Excel-Mappen nach dem Tabellenblatt "Data" durchsucht:
Sub TabellenPPTeinfuegen()
Dim msE As Object
Dim wbk As Workbook, wsh As Worksheet
Set msE = GetObject(, "Excel.Application")
For Each wbk In msE.Workbooks
For Each wsh In wbk.Worksheets
If wsh.Name = "Data" Then
wsh.Range("A5:M6").Copy
pptPres.Slides(4).Shapes.Paste
Exit Sub
End If
Next
Next
End Sub
Viele Grüße
Martin

Anzeige
...ergänzender Hinweis
06.10.2014 12:13:45
Martin
Hallo Paddy_P,
noch ein ergänzender Hinweis: Das von mir vorgschlagene Makro hat den Vorteil, dass das korrekte Tabellenblatt in allen Excel-Mappen einer geöffneten Excel-Instanz automatisch gesucht wird (...also weder die Excelmappe und das Tabellenblatt müssen aktiv sein!). Sollten aber mehrere Excel-Instanzen geöffnet sein, werden nur die Excelmappen in der zuerst geöffneten Excel-Instanz durchsucht (...auch dein Makro kann die Datei nur in der zuerst geöffneten Excel-Instanz finden). Um alle Excelmappen in allen Excel-Instanzen zu durchsuchen, muss mit API-gearbeitet werden: http://excel.tips.net/T009451_Finding_Other_Instances_of_Excel_in_a_Macro.html
Das kann ich auch umsetzen, aber nur wenn du es explizit wünscht.
Viele Grüße
Martin

Anzeige
AW: ...ergänzender Hinweis
06.10.2014 12:48:09
Paddy_P
Danke!
Da ich eine ne schnelle Lösung brauche hab ich einfach deinen Vorschlag übernommen.
Jetzt funktioniert wenigstens das Auslesen des Ranges in Excel, dummerweise stellt sich jetzt powerpoint quer beim einfügen selbiger Werte...
Es gibt nen etwas seltsamen Fehler:
Laufzeitfehler '-2147188160 (80048240)':
Shapes.Paste : Invalid request. Clipboard is empty or contains data which may not be pasted here.

Wenn ich den Range manuell paste funktioniert es.
Bzw. falls ich irgendeinen String in das clipboard hole und F8 drücke, funktioniert es auch...
Muss ich im Code evtl. etwas anderes als "paste" verwenden?

Anzeige
AW: ...ergänzender Hinweis
06.10.2014 16:34:18
Martin
Hallo Paddy_P,
mein erster Vorschlag wäre es den Vorgang des Einfügens der Daten direkt in PowerPoint mit dem Makrorecorder aufzuzeichnen. Vielleicht "spuckt" der Makrorecorder den passenden VBA-Code aus. Sonst kannst du es mal so ausprobieren:
Sub TabellenPPTeinfuegen()
Dim msE As Object
Dim wbk As Workbook, wsh As Worksheet
Dim iRow As Integer, iCol As Integer
Dim strRange As String
Dim objClipboard As Object
Set objClipboard = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
Set msE = GetObject(, "Excel.Application")
For Each wbk In msE.Workbooks
For Each wsh In wbk.Worksheets
If wsh.Name = "Data" Then
'Daten als Textform aufbereiten
For iRow = 5 To 6
For iCol = 1 To 13
If iCol  1 Then strRange = strRange & vbTab
strRange = strRange & wsh.Cells(iRow, iCol).Text
Next
strRange = strRange & vbNewLine
Next
'Daten in Zwischenablage kopieren
With objClipboard
.SetText strRange
.PutInClipboard
End With
pptPres.Slides(4).Shapes.Paste
Exit Sub
End If
Next
Next
End Sub
Jetzt werden aber keinerlei Formatierungen (z.B. Zellrahmen usw.) übertragen.
Viele Grüße
Martin

Anzeige
....Schade, mal wieder keine Rückmeldung!
07.10.2014 15:55:35
Martin
Hallo Paddy,
leider reihst du dich in die Liste der Nichtantworter ein, die ohne Rückmeldung oder Danke den Beitrag einfach "verkümmern" lassen. Naja, mir ist es zu anstrengend weiterhin ständig nachzusehen, ob du endlich geantwortet hast. Es ist ja nicht so, dass ich nichts Besseres zu tun habe als anderen zu helfen. :(
Martin

AW: ....Schade, mal wieder keine Rückmeldung!
07.10.2014 15:59:38
Paddy_P
Hallo,
sorry ich hatte heute zwei mal versucht zu antworten, aber jedes mal wenn ich auf Vorschau geklickt hatte war meine Nachricht weg...
Falls die Nachricht jetzt ankommen sollte werde ich das schreiben was ich heute Mittag versucht hatte zu schreiben...

Anzeige
AW: ....Schade, mal wieder keine Rückmeldung!
07.10.2014 16:05:14
Paddy_P
Ok, jetzt scheint es hoffentlich funktioniert zu haben.
ALso Danke nochmals für deine Hilfe!
Ich habe verschiedene Sachen ausprobiert und konnte jetzt folgenden Code schreiben:
Function TabellenPPTeinfuegen(pptPres)
Dim msE As Object
Dim wbk As Workbook
Dim wsh As Worksheet
Dim objPPT As Object
Set objPPT = CreateObject("Powerpoint.Application")
Set msE = GetObject(, "Excel.Application")
For Each wbk In msE.Workbooks
For Each wsh In wbk.Worksheets
If wsh.Name = "Data" Then
wsh.Range("C5:M6").Copy
pptPres.Slides(4).Select
objPPT.CommandBars.ExecuteMso ("PasteSourceFormatting")
With pptPres.Slides(4).Shapes("Tabelle 1")
.Left = 20
.Top = 94
.Width = 518
.Height = 28
End With
End If
Next
Next
End Function
Ich denke, dass das gerade für andere interessant sein könnte die ebenfalls wie ich auf der suche sind Tabellen aus Excel in Powerpoint zu kopieren.
Seit 2010 gibt es anscheinend den neuen Befehl: "CommandBars.ExecuteMso()" dieser hat mir hier geholfen dass zu erreichen was ich machen wollte.
Wie gesagt nochmals Danke für deine Hilfe!
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige