Daten Auswahl von Excel in vorhandene PowerPoint Präsentation einfügen per excel makro

  • Excel

Es gibt 1 Antwort in diesem Thema. Der letzte Beitrag () ist von petaod.

    Daten Auswahl von Excel in vorhandene PowerPoint Präsentation einfügen per excel makro

    Hallo Community,

    Ich bin relativ neu im VBA Bereich unterwegs. Da ich mich aber in das Thema einarbeiten will, versuche ich mich gerade an meinen ersten Makros.
    Ich bräuchte ein Makro was mir einen bestimmten Datenbereich aus Excel als Bild-Datei in einer vorhandenen PowerPoint Datei kopiert und einfügt.
    Dabei soll die Vorlage aus der PowerPoint verwendet werden.

    Das ist der Code, auf welchen ich durch das WWW gestoßen bin. Hier funktioniert eigentlich schon alles soweit, wie ich das will, jedoch wird hier eine komplett neue
    Präsentation verwendet und auf keine vorhandene PPT zugegriffen.

    Hierbei bräuchte ich eure HIlfe - das ist der Code:

    Quellcode

    1. Sub ExcelRangeToPowerPoint()
    2. Dim rng As Range
    3. Dim PowerPointApp As Object
    4. Dim myPresentation As Object
    5. Dim mySlide As Object
    6. Dim myShape As Object
    7. 'Copy Range from Excel
    8. Set rng = ThisWorkbook.ActiveSheet.Range("A1:C12")
    9. 'Create an Instance of PowerPoint
    10. On Error Resume Next
    11. 'Is PowerPoint already opened?
    12. Set PowerPointApp = GetObject(class:="PowerPoint.Application")
    13. 'Clear the error between errors
    14. Err.Clear
    15. 'If PowerPoint is not already open then open PowerPoint
    16. If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
    17. 'Handle if the PowerPoint Application is not found
    18. If Err.Number = 429 Then
    19. MsgBox "PowerPoint could not be found, aborting."
    20. Exit Sub
    21. End If
    22. On Error GoTo 0
    23. 'Optimize Code
    24. Application.ScreenUpdating = False
    25. 'Create a New Presentation
    26. Set myPresentation = PowerPointApp.Presentations.Add
    27. 'Add a slide to the Presentation
    28. Set mySlide = myPresentation.Slides.Add(1, 11) '11 = ppLayoutTitleOnly
    29. 'Copy Excel Range
    30. rng.Copy
    31. 'Paste to PowerPoint and position
    32. mySlide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile
    33. Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
    34. 'Set position:
    35. myShape.Left = 356
    36. myShape.Top = 152
    37. 'Make PowerPoint Visible and Active
    38. PowerPointApp.Visible = True
    39. PowerPointApp.Activate
    40. 'Clear The Clipboard
    41. Application.CutCopyMode = False
    42. End Sub
    Meiner Erfahrung nach kannst du das ganze Geraffel von Zeile 10 bis 26 weglassen, weil GetObject immer auf die Schnauze fällt.
    CreateObject gibt dir eine neue oder (falls offen) eine bestehende Anwendung zurück.

    Folgende Funktion gibt dir eine bestehende Presentation zurück oder erzeugt eine neue (falls keine existiert oder du es forcieren willst).

    Visual Basic-Quellcode

    1. Function PowerpointPresentation(Optional ByVal CreateNewPresentation As Boolean) As Object
    2. Dim PP As Object
    3. Set PP = CreateObject("PowerPoint.Application")
    4. PP.Visible = True
    5. If CreateNewPresentation Or PP.Presentations.Count = 0 Then
    6. Set PowerpointPresentation = PP.Presentations.Add
    7. Else
    8. Set PowerpointPresentation = PP.Presentations(1)
    9. End If
    10. End Function

    Damit kannst du Zeile 10-31 ersetzen durch

    Visual Basic-Quellcode

    1. Set MyPresentation = PowerPointPresentation
    2. Set PowerPointApp = MyPresentation.Application
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --