Anzeige
Archiv - Navigation
1184to1188
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Per Kopfdruck ab Excel-Tabelle eine PPT

Per Kopfdruck ab Excel-Tabelle eine PPT
Mapsi
Hallo
ist es möglich, ab einer Excel-Arbeitsmappe per Knopfdruck von jedem Tabellenblatt separat in Powerpoint eine Folie zu erstellen ?
Natürlich mit dem Inhalt der jeweiligen Tabellenblätter
Danke für die Inputs

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
Code gefunden aber - Laufzeifehler :-(
16.11.2010 14:57:42
Mapsi
mittlerweilen hab ich durch langes "googeln" folgenden Code gefunden, der eigentlich genau das machen müsste, was ich mir wünsche:
Function SelectArea() As String
Dim Internrange As Range
Dim rngBereich
Dim Rletzte, Cletzte As Long
On Error GoTo Brutt
Set Sourcebok = ActiveWorkbook
Rletzte = Range("A65536").End(xlUp).Row
Cletzte = Range("IV1").End(xlToLeft).Column
Set rngBereich = Range(Cells(1, 1), Cells(Rletzte, Cletzte + 1))
SelectArea = rngBereich.Address
Exit Function
Brutt:
SelectArea = "A1"
End Function
Function sShortname(ByVal Orrginal As String) As String
Dim iii As Long
sShortname = ""
For iii = 1 To Len(Orrginal)
If Mid(Orrginal, iii, 1) " " Then _
sShortname = sShortname & Mid(Orrginal, iii, 1)
Next
End Function
Function fctVerzeichnisExists(oname) As Boolean
On Error GoTo Fehler
ChDir oname
fctVerzeichnisExists = True
Exit Function
Fehler:
fctVerzeichnisExists = False
End Function
Public Sub Alle_Bilder_ppt()
Dim varReturn As Variant
Dim MyAddress As String
Dim SaveName As Variant
Dim MySuggest As String
Dim oname As String
Dim Hi As Long
Dim Wi As Long
Dim Suffiks As Long
Dim Tagdat, tach, mon, ja  As String
Dim Tabellen As Integer
Dim appPP As Object, Slide As Object
For Tabellen = 1 To Worksheets.Count   'Schleife über Tabellenblätter
Set Sourcebok = ActiveWorkbook
Worksheets(Tabellen).Activate
MySuggest = sShortname(ActiveSheet.Name)
Sourcebok.Activate
MyAddress = SelectArea
If MyAddress  "A1" Then
Tagdat = Format(Date, "yyyy-mm-dd")
oname = "C:\Temp\PPts\" & Tagdat
If Not fctVerzeichnisExists(oname) Then
MkDir oname
Else
End If
SaveName = oname & "\" & MySuggest _
& ".ppt"
Range(MyAddress).Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
Set appPP = CreateObject("PowerPoint.Application")
With appPP
.Visible = True
.Presentations.Open Filename:="C:\Temp\Leere-Vorlage.ppt", ReadOnly:=msoFalse
.ActivePresentation.Slides.Add 1, ppLayoutBlank
Set Slide = .ActivePresentation.Slides(1)
Slide.Shapes.Paste
With Slide.Shapes(1)
.Left = 30
.Top = 130
End With
End With
If SaveName = False Then
GoTo Avbryt
End If
With appPP
.Visible = msoTrue
.ActivePresentation.SaveAs (SaveName)
.ActivePresentation.Close
.Quit
End With
Sourcebok.Activate
End If
Avbryt:
On Error Resume Next
Application.StatusBar = False
Next Tabellen  'nächstes Worksheet
End Sub

Mein Problem ist nun aber, dass das Makro mir zwar eine PPT öffnet und dann aber bei der folgenden Zeile stehen bleibt:
.ActivePresentation.Slides.Add 1, ppLayoutBlank
Fehlermeldung: Laufzeifehler
Slides.Add:Invalid enumeration value
Was mach ich falsch oder was muss ich im obigen Code noch ändern ?
HERZLICHEN DANK FÜR DIE HILFE !
Anzeige
AW: Code gefunden aber - Laufzeifehler :-(
16.11.2010 18:21:12
Case
Hallo,
habe den Code jetzt nicht angeschaut bzw. getestet, aber das Problem liegt hier - "Dim appPP As Object, Slide As Object". Du deklarierst "Early Binding" - sprich Du müsstest einen Verweis (VBA-Editor - Extras - Verweise...) auf die PowerPoint-Bibliothek setzen, aber du nutzt dann im Code ".ActivePresentation.Slides.Add 1, ppLayoutBlank" durch diese Codezeile "Late Binding". Für die Richtung "Excel - PowerPoint" habe ich in meinem Blog mal zwei Beispiele dargestellt:
Excel PowerPoint...
Excel PowerPoint 1...
Das sollte als Ansatz genügen. :-)
Servus
Case

Anzeige
AW: Code gefunden aber - Laufzeifehler :-(
17.11.2010 08:46:52
Mapsi
Hi Case
Danke mal herzlich für diese wunderbaren Inputs !
ich werde mir diese beiden Ansätze in einer ruhigen Minute mal zu Gemüte führen.
Rückmeldung folgt selbstverständlich
Mapsi

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige