Office: (Office 2016) Excel Inhalte in PowerPoint Vorlage übertragen

Hallo zusammen,

ich versuche Aktuell mir ein Makro zu basteln um mir die Arbeit zu erleichtern.
Folgender Sachverhalt liegt vor. Ich habe eine Eingabemaske erstellt mit der ich in eine Tabelle Werte (Texte) eintrage. Durch einen SVerweis wähle ich bestimmt Inhalte aus, welche ich dann in eine Powerpoint Vorlage integrieren möchte.

Aktuell scheitere ich an dem Übertragen in PP. Meine Vorlage kann ich mit dem Button öffnen allerdings reich dann meine Kentnisse nicht mehr aus um die Werte zu übertragen.

Der Code sieht aktuell so aus:
Sub Schaltfläche4_Klicken()
Dim PowerPoint As Object
Set PowerPoint = CreateObject("Powerpoint.Application")
PowerPoint.Visible = True

PowerPoint.Presentations.Open ("file://srvditz1\HOME$\....\Desktop\....%20Steckbrief%20Testversion.potm.pptx")
End Sub

Mir ist klar das der Großteil des Codes fehlt. Ich habe schon mehrere Tutorials angeschaut und Codes versucht aber leider ohne Erfolg.
Ich muss dazu sagen das ich relativ wenig Ahnung mit VBA habe.

Ich möchte jetzt aus meiner Excel Zelle G3, G4, G5, ... etc. in die passenden Bereiche der PP (Titel 1, Untertitel2, etc.) übertragen. Kann mir jemand beim Code helfen? Am bestenn soll noch eine Kopie der Vorlage verwendet werden und nicht das Original.

Danke und Gruß

 

Mahlzeit,

Vorschlag unter Verwendung der IntelliSense (EarlyBinding), um das entwickeln in der Anfangszeit zu vereinfachen.
Umschreiben als LateBinding zur Weitergabe des Codes kannste im fertigen zustand immernoch:



Option Explicit

Sub openPPT()
'EarlyBinding um IntelliSense zu benutzen
'Hinweis:
'Im VB-Editor muss unter Extras -> Verweise -> auf Microsoft PowerPoint verwiesen werden
Dim appPPT As PowerPoint.Application
Dim sPPTfile As String
Dim wkb As Workbook
Dim wks As Worksheet
'
On Error GoTo err
'
Set wkb = ThisWorkbook
Set wks = wkb.Worksheets(1) ' <--- Referenz auf das erste Tabellenblatt
Set appPPT = New PowerPoint.Application
'
sPPTfile = "c:\Pfad\PowerPoint.pptx"
'
With appPPT
.OpenThemeFile (sPPTfile) 'öffnen der Datei
.Visible = msoTrue 'Anzeigen der Datei
'je nachdem was für Objekte in der PPT sind,
'ab hier die Wertzuweisung Deiner Excel-Zelle

'objObjekte = wks.Range("").value2

End With
'


err:
If err.Number <> 0 Then
MsgBox err.Number & vbCrLf & err.Description
End If
'
Set appPPT = Nothing
End Sub

 

Hallo,

offenbar ein sehr mutiger Schritt angesichts: VBA - Excel-Objektsystem - PowerPoint-Objektsystem.

In der beiliegenden Excel-Datei habe ich dir im allgemeinen Codemodul "Modul1" das folgende Makro (mit reichlich Kommentaren) eingefügt:

Code:

Option Explicit

#Const Early_Binding = False      'Variable für die bedingte Makro-Compilierung

Sub Schaltfläche4_klicken()
  Dim AppEX As Excel.Application  'Zeigervariable auf die Excel-Anwendungsinstanz
  Dim WbkEX As Excel.Workbook     'Zeigervariable auf die Excel-Arbeitsmappe
  Dim WshEX As Excel.Worksheet    'Zeigervariable auf das (aktive) Excel-Arbeitsblatt
  
  Dim PfadPrsPP As String         'Stringvariable für Pfad+Name der PowerPoint-Präsentationsdatei
  
 'Tritt ein Fehler bei der Makroausführung auf, springe zur Marke "Err_Sch4:"
  On Error GoTo Err_Sch4
  
'Mit "#" werden Abschnitte bedingter VBA-Makrocompilierung gekennzeichnet:
#If Early_Binding Then
 'Setzt voraus, dass ein verfügbarer Verweis
 'auf die "Microsoft PowerPoint 16.0 ObjectLibrary" existiert:
 'Die Eigenschaften, Methoden und Ereignisse der PP-Anwendung sind
 'dann bereits zur Entwurfs/Kompilier-Zeit verfügbar
  Dim AppPP As New PowerPoint.Application
  Dim PrsPP As PowerPoint.Presentation
#Else
 'Setzt nur voraus, dass die "Powerpoint-Anwendung" unter Windows registriert ist:
 'Die PP-Anwendung wird erst zur Run-Time geladen und die Instanz erzeugt;
 'Zur Entwurfs/Kompilier-Zeit sind keine weiteren Informationen über die Objekte verfügbar.
  Dim AppPP As Object               'Zeigervariable (für die PowerPoint-Anwendung)
  Dim PrsPP As Object               'Zeigervariable (für die PowerPoint-Präsentation)
  Set AppPP = CreateObject("Powerpoint.Application")
#End If
  
  Set AppEX = Application           'Zeiger auf die Excel-Anwendung-Instanz
  Set WbkEX = AppEX.ActiveWorkbook  'Zeiger auf die Excel-Arbeitsmappe
  Set WshEX = WbkEX.ActiveSheet     'Zeiger auf das (aktive) Excel-Arbeitsblatt
  
 'Die PowerPoint-Anwendung ist geladen - Mache sie sichtbar!
  AppPP.Visible = True
  With WshEX
   'Aus den Excel-Zellen G1 und G2 des aktiven Arbeitsblattes
   'ermittle den Pfad zur PowerPoint-Präsentationsdatei:
    PfadPrsPP = .Range("G1") & .Range("G2")
  End With
 'Öffne die PowerPoint-Präsentationsdatei:
  Set PrsPP = AppPP.Presentations.Open(Filename:=PfadPrsPP)
  
 'Für die 1. Folie der PowerPoint-Präsentationsdatei tue Folgendes:
  With PrsPP.Slides(1)
   'Kopiere den Inhalt der Excel-Zelle G3 in die Zwischenablage von Windows
    WshEX.Range("G3").Copy
   'Füge den Inhalt der Zwischenablage von Windows
   'in den Textrahmen der Form "Title 1" der 1. PowerPoint-Folie ein
   '(Setzt natürlich voraus, dass eine Form dieses Namens bereits existiert):
    .Shapes("Title 1").TextFrame.TextRange.Paste

   'Kopiere den Inhalt der Excel-Zelle G4 in die Zwischenablage von Windows
    WshEX.Range("G4").Copy
   'Füge den Inhalt der Zwischenablage von Windows
   'in den Textrahmen der Form "Subtitle 2" der 1. PowerPoint-Folie ein:
    .Shapes("Subtitle 2").TextFrame.TextRange.Paste
  End With
  
 'Beende den Ausschneide/Kopiermodus der Excel-Anwendung:
  AppEX.CutCopyMode = False
  
 'Speichere eventuell die PowerPoint-Präsentationsdatei unter neuem Pfad+Namen:
 'PrsPP.SaveAs Filename:="\\srvditz1\C$\Pfad\PP-Pr?sentation.pptx"

 'Oder aber speichere die so produzierte PowerPoint-Präsentationsdatei
 'unter identischem Pfad+Namen ab:
  PrsPP.Save
  
Ex_Sch4:
 'Falls noch ein gültiger Zeiger auf die PowerPoint-Anwendung besteht:
  If Not AppPP Is Nothing Then
   'Beende die PowerPoint-Anwendung:
    AppPP.Quit
   'Zerstöre den Zeiger auf die PowerPoint-Anwendung und
   'gib sie damit für die Garbage-Collection von Windows frei:
    Set AppPP = Nothing
  End If
 'Verlasse die SUB
  Exit Sub
  
Err_Sch4:
 'Es ist ein Fehler aufgetreten - Zeige die Fehlerdetails an:
  MsgBox Prompt:="Fehler " & Err.Number & " (" & Err.Description & ")"
 'Fahre mit der Makroausführung bei der Marke "Ex_Sch4:" fort:
  Resume Ex_Sch4
End Sub

Das Makro erwartet:

1. in der Excel-Zelle G1 den vollständigen Pfad zum Verzeichnis, in dem die PowerPoint-Präsentationsdatei enthalten ist (mit abschließendem "").
2. in der Excel-Zelle G2 den Namen der PowerPoint-Präsentationsdatei (mit abschließender Dateierweiterung, wie zB. ".pptx")
3. in der Excel-Zelle G3 den Textinhalt, der in der PP-Datei von Punkt 2) in der 1. Folie in die bereits existierende Form "Title 1" kopiert werden soll.
4. in der Excel-Zelle G4 den Textinhalt, der in der PP-Datei von Punkt 2) in der 1. Folie in die bereits existierende Form "Subtitle 2" kopiert werden soll.

Mit Klick auf die "Schaltfläche 4" im Excel-Arbeitsblatt "Tabelle1" wird obiges Makro ausgeführt:

• Die PP-Anwendung wird geladen
• Die PP-Präsentationsdatei aus Punkt 1)+2) wird geladen
• Die Formen aus Punkt 3)+4) werden mit den Texten versehen.
• Die PP-Präsentationsdatei wird gespeichert am identischen Ort/Namen.
• Die PP-Anwendung wird beendet.

Tritt dabei ein Fehler auf, wird dieser angezeigt und danach des Makro beendet (mit gleichzeitiger Beendigung der PP-Anwendung).