Exceldaten nach Powerpoint

letztezeile = wksDaten.Cells(Rows.Count, 1).End(xlUp).row Set pptApp = CreateObject("PowerPoint.Application") pptApp.Visible = msoTrue Set pptPres = pptApp.Presentations.Open(ThisWorkbook.Path & "\Statusblätter- _ Statusfahrt_Vorlage.potx") 'For i = 2 To letztezeile i=2 'für jedes Fahrzeug ein Slide bdummy = SchreibeFahrzeugppt(i, pptPres) 'Next i

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo yummi,
hier das Gerüst für ein entsprechendes Makro.
Da das Duplikat der 1. Folie immer an der 2. Position eingefügt wird muss die Excelliste vom Ende her abgearbeitet werden, damit die Reihenfolge der Folien stimmt.
Gruß
Franz

Sub MakePP_Praesentation()
If MsgBox("Präsentation erstellen?", _
vbQuestion + vbOKCancel, _
"Makro: MakePP_Praesentation") = vbCancel Then Exit Sub
Dim letztezeile As Long
Dim Zeile As Long
Dim Spalte As Long
Dim wksDaten As Worksheet
Dim pptApp As Object 'PowerPoint.Application
Dim pptPres As Object  'PowerPoint.Presentation
Dim pptSlide As Object  'PowerPoint.Slide
Dim pptSlideMaster As Object  'PowerPoint.Slide
Dim pptShape As Object  'PowerPoint.Shape
Dim strShape As String
Set wksDaten = ActiveWorkbook.Worksheets("Tabelle1")
With wksDaten
letztezeile = wksDaten.Cells(.Rows.Count, 1).End(xlUp).Row
End With
Set pptApp = CreateObject("PowerPoint.Application")
pptApp.Visible = msoTrue
Set pptPres = pptApp.Presentations.Open(ThisWorkbook.Path _
& "\Statusblätter-Statusfahrt_Vorlage.potx", untitled:=msoTrue)
Set pptSlideMaster = pptPres.Slides(1)
For Zeile = letztezeile To 2 Step -1
'für jedes Fahrzeug ein Slide
pptSlideMaster.Duplicate
Set pptSlide = pptPres.Slides(2)
'Spalten in der Zeile abarbeiten
For Spalte = 1 To 3
'Spalte der entsprechenden Textbox/Textfeld zuordnen
Select Case Spalte
Case 1: strShape = "Textfeld 3" 'Marke
Case 2: strShape = "Textfeld 4" 'Model
Case 3: strShape = "Textfeld 5" 'Farbe
End Select
Set pptShape = pptSlide.Shapes(strShape)
With pptShape
.TextFrame.TextRange.Text = wksDaten.Cells(Zeile, Spalte).Text
End With
Next Spalte
Next Zeile
pptSlideMaster.Delete
With pptApp.FileDialog(msoFileDialogSaveAs)
.Show
.Execute
End With
Set pptShape = Nothing
Set pptSlide = Nothing
Set pptSlideMaster = Nothing
Set pptPres = Nothing
Set pptApp = Nothing
End Sub

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Exceldaten nach Powerpoint

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread