Microsoft Excel

Herbers Excel/VBA-Archiv

Von aktivem Powerpoint auf Excel zugreifen

Betrifft: Von aktivem Powerpoint auf Excel zugreifen von: Paddy_P
Geschrieben am: 06.10.2014 10:10:01

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?

  

Betrifft: AW: Von aktivem Powerpoint auf Excel zugreifen von: Martin
Geschrieben am: 06.10.2014 10:25:14

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


  

Betrifft: ...beste Lösung von: Martin
Geschrieben am: 06.10.2014 10:33:19

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


  

Betrifft: AW: Von aktivem Powerpoint auf Excel zugreifen von: Paddy_P
Geschrieben am: 06.10.2014 10:41:41

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...


  

Betrifft: AW: Von aktivem Powerpoint auf Excel zugreifen von: Martin
Geschrieben am: 06.10.2014 11:36:51

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


  

Betrifft: ...ergänzender Hinweis von: Martin
Geschrieben am: 06.10.2014 12:13:45

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


  

Betrifft: AW: ...ergänzender Hinweis von: Paddy_P
Geschrieben am: 06.10.2014 12:48:09

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?


  

Betrifft: AW: ...ergänzender Hinweis von: Martin
Geschrieben am: 06.10.2014 16:34:18

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


  

Betrifft: ....Schade, mal wieder keine Rückmeldung! von: Martin
Geschrieben am: 07.10.2014 15:55:35

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


  

Betrifft: AW: ....Schade, mal wieder keine Rückmeldung! von: Paddy_P
Geschrieben am: 07.10.2014 15:59:38

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...


  

Betrifft: AW: ....Schade, mal wieder keine Rückmeldung! von: Paddy_P
Geschrieben am: 07.10.2014 16:05:14

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!


 

Beiträge aus den Excel-Beispielen zum Thema "Von aktivem Powerpoint auf Excel zugreifen"