Tabelle aus Excel in PowerPoint einfügen
02.11.2018 20:03:11
Anna
gibt es eine Möglichkeit eine Tabelle aus Excel in eine PowerPoint Präsentation zu kopieren? Mein bisheriges Makro öffnet mir ein pp-Template in dem sich bereits Tabellen befinden. Pro Slide eine Tabelle. Die Tabellen sind auch durchnummeriert (Tabelle1-5), ebenso heißen sie auch in den Excel-Sheets.
Bisher habe ich es nur so hingekriegt, dass ich jede Zelle in pp einzeln mit der jeweiligen Zelle aus der Excel Tabelle befüllen/ansprechen muss.
Ich würde gerne eine Möglichkeit finden, das ganze ein bisschen dynamisch zu halten & evtl über Link & weiter bearbeiten einfügen zu können - in VBA fehlt mir aber dazu das Wissen bzw. der Makrorekorder hilft nicht wirklich weiter.
Ein "foto" der Excel Tabelle einfügen ist auch nicht optimal, da ich die Tabelle in pp dann nicht weiter befüllen kann.
Bin für jeden Tipp dankbar!!
Bisher löse ich das ganze so:
Sub pptPRErzeugen()
Dim app As Object
Dim ppt As Object
Dim speicherOrt As String 'Hier wird die Fertige Präsentation gespeichert;
Dim InvalidChars As String
Dim Pfad As String
Dim i As Integer
Dim SlideNum As Integer
Dim oPPTShape As PowerPoint.Shape
Dim oPPTFile As PowerPoint.Presentation
InvalidChars = "*?|" & Chr$(34) 'Ungültige Zeichen im Dateinamen; chr(34): "
Pfad = "C:\Desktop\Vorlage\Template.pptx" 'Hier den Pfad, wo Template liegt
speicherOrt = "C:\Desktop\Vorlage\ 'Hier Pfad, wo fertige PPP-Datei liegt
'Der generierte Speicherort wird auf ungültige Zeichen überprüft
For i = 1 To Len(InvalidChars)
If InStr(speicherOrt, Mid$(InvalidChars, i, 1)) 0 Then
speicherOrt = Replace(speicherOrt, Mid$(InvalidChars, i, 1), "") 'Bei einem ungültigen _
Speicherort werden ungültige Zeichen weggelassen
End If
Next i
Set app = CreateObject("PowerPoint.Application")
app.Visible = msoTrue
Set ppt = app.Presentations.Open(Pfad)
'Befuelle Tabelle1 auf Folie 2
SlideNum = 2
ppt.Slides(SlideNum).Select
Set oPPTShape = ppt.Slides(SlideNum).Shapes("Tabelle1")
Sheets("Namensliste").Activate
oPPTShape.Table.Cell(2, 1).Shape.TextFrame.TextRange.Text = Cells(2, 6).Text
oPPTShape.Table.Cell(2, 2).Shape.TextFrame.TextRange.Text = Cells(2, 7).Text
oPPTShape.Table.Cell(2, 3).Shape.TextFrame.TextRange.Text = Cells(2, 8).Text
oPPTShape.Table.Cell(3, 1).Shape.TextFrame.TextRange.Text = Cells(3, 6).Text
oPPTShape.Table.Cell(3, 2).Shape.TextFrame.TextRange.Text = Cells(3, 7).Text
oPPTShape.Table.Cell(3, 3).Shape.TextFrame.TextRange.Text = Cells(3, 8).Text
oPPTShape.Table.Cell(4, 1).Shape.TextFrame.TextRange.Text = Cells(5, 6).Text
oPPTShape.Table.Cell(4, 2).Shape.TextFrame.TextRange.Text = Cells(5, 7).Text
oPPTShape.Table.Cell(4, 3).Shape.TextFrame.TextRange.Text = Cells(5, 8).Text
oPPTShape.Table.Cell(5, 1).Shape.TextFrame.TextRange.Text = Cells(6, 6).Text
oPPTShape.Table.Cell(5, 2).Shape.TextFrame.TextRange.Text = Cells(6, 7).Text
oPPTShape.Table.Cell(5, 3).Shape.TextFrame.TextRange.Text = Cells(6, 8).Text
oPPTShape.Table.Cell(6, 1).Shape.TextFrame.TextRange.Text = Cells(7, 6).Text
oPPTShape.Table.Cell(6, 2).Shape.TextFrame.TextRange.Text = Cells(7, 7).Text
oPPTShape.Table.Cell(6, 3).Shape.TextFrame.TextRange.Text = Cells(7, 8).Text
oPPTShape.Table.Cell(7, 1).Shape.TextFrame.TextRange.Text = Cells(8, 6).Text
oPPTShape.Table.Cell(7, 2).Shape.TextFrame.TextRange.Text = Cells(8, 7).Text
oPPTShape.Table.Cell(7, 3).Shape.TextFrame.TextRange.Text = Cells(8, 8).Text
oPPTShape.Table.Cell(8, 1).Shape.TextFrame.TextRange.Text = Cells(9, 6).Text
oPPTShape.Table.Cell(8, 2).Shape.TextFrame.TextRange.Text = Cells(9, 7).Text
oPPTShape.Table.Cell(8, 3).Shape.TextFrame.TextRange.Text = Cells(9, 8).Text
oPPTShape.Table.Cell(9, 1).Shape.TextFrame.TextRange.Text = Cells(10, 6).Text
oPPTShape.Table.Cell(9, 2).Shape.TextFrame.TextRange.Text = Cells(10, 7).Text
oPPTShape.Table.Cell(9, 3).Shape.TextFrame.TextRange.Text = Cells(10, 8).Text
oPPTShape.Table.Cell(10, 1).Shape.TextFrame.TextRange.Text = Cells(11, 6).Text
oPPTShape.Table.Cell(10, 2).Shape.TextFrame.TextRange.Text = Cells(11, 7).Text
oPPTShape.Table.Cell(10, 3).Shape.TextFrame.TextRange.Text = Cells(11, 8).Text
oPPTShape.Table.Cell(11, 1).Shape.TextFrame.TextRange.Text = Cells(12, 6).Text
oPPTShape.Table.Cell(11, 2).Shape.TextFrame.TextRange.Text = Cells(12, 7).Text
oPPTShape.Table.Cell(11, 3).Shape.TextFrame.TextRange.Text = Cells(12, 8).Text
oPPTShape.Table.Cell(12, 1).Shape.TextFrame.TextRange.Text = Cells(13, 6).Text
oPPTShape.Table.Cell(12, 2).Shape.TextFrame.TextRange.Text = Cells(13, 7).Text
oPPTShape.Table.Cell(12, 3).Shape.TextFrame.TextRange.Text = Cells(13, 8).Text
oPPTShape.Table.Cell(13, 1).Shape.TextFrame.TextRange.Text = Cells(14, 6).Text
oPPTShape.Table.Cell(13, 2).Shape.TextFrame.TextRange.Text = Cells(14, 7).Text
oPPTShape.Table.Cell(13, 3).Shape.TextFrame.TextRange.Text = Cells(14, 8).Text
oPPTShape.Table.Cell(14, 1).Shape.TextFrame.TextRange.Text = Cells(15, 6).Text
oPPTShape.Table.Cell(14, 2).Shape.TextFrame.TextRange.Text = Cells(15, 7).Text
oPPTShape.Table.Cell(14, 3).Shape.TextFrame.TextRange.Text = Cells(15, 8).Text
oPPTShape.Table.Cell(15, 1).Shape.TextFrame.TextRange.Text = Cells(16, 7).Text
oPPTShape.Table.Cell(15, 2).Shape.TextFrame.TextRange.Text = Cells(16, 7).Text
oPPTShape.Table.Cell(15, 3).Shape.TextFrame.TextRange.Text = Cells(16, 8).Text
oPPTShape.Table.Cell(16, 1).Shape.TextFrame.TextRange.Text = Cells(17, 7).Text
oPPTShape.Table.Cell(16, 2).Shape.TextFrame.TextRange.Text = Cells(17, 7).Text
oPPTShape.Table.Cell(16, 3).Shape.TextFrame.TextRange.Text = Cells(17, 8).Text
oPPTShape.Table.Cell(17, 1).Shape.TextFrame.TextRange.Text = Cells(18, 6).Text
oPPTShape.Table.Cell(17, 2).Shape.TextFrame.TextRange.Text = Cells(18, 7).Text
oPPTShape.Table.Cell(17, 3).Shape.TextFrame.TextRange.Text = Cells(18, 8).Text
speicherOrt = Replace(Pfad, "Template", Format(DateTime.Now, "yymmdd") & "_" & "Test")
ppt.SaveAs (speicherOrt)
ppt.Close
app.Quit
MsgBox "Präsentation erstellt", vbOKOnly + vbInformation
End Sub