AW: from Excel to PowerPoint
28.03.2005 16:13:38
volti
Hallo,
mittlerweile bin ich ein Stück weitergekommen und es wird mit folgendem Code eine PPT geöffnet oder neu angelegt und auch meine Exceltabelle nach PowerPoint kopiert.
Allerdings werden nach dem PASTE-Befehl keine weiteren Befehle (z.B. formatieren und abspeichern) mehr ausgeführt; als wenn hier abgebrochen würde. Kann ich mir nicht erklären, es kommt auch keine Fehlermeldung.
Weiß jemand Rat?
viele Grüße KH
Sub PowerPoint_bearbeiten()
Dim pptAppl As Object
Dim pptPres As Object
Dim pptFolie As Object
Dim pptFilename As String
ppLayoutBlank = 12 'nur Leerblatt
'PowerPointobjekt kreieren und Merker setzen, ob schon offen oder neu war
On Error Resume Next
Set pptAppl = GetObject(, "PowerPoint.Application")
If pptAppl Is Nothing Then
Set pptAppl = CreateObject("PowerPoint.Application")
WarOffen = False
Else
WarOffen = True
End If
pptAppl.Visible = msoTrue
'Vorgegebene Datei öffnen bzw. neue Präsentation kreieren
pptFilename = "C:\19AT_Mitte.ppt"
If Dir$(pptFilename) <> "" Then
Set pptPres = pptAppl.Presentations.Open(pptFilename)
FileWarDa = True
Else
Set pptPres = pptAppl.Presentations.Add
Set pptFolie = pptPres.Slides.Add(1, ppLayoutBlank)
FileWarDa = False
End If
'Daten aus Zwischenablage kopieren
pptAppl.ActivePresentation.Slides(1).Select 'Folie auswählen
pptAppl.ActiveWindow.ViewType = 1
pptAppl.ActiveWindow.View.Paste
MsgBox "ok" 'ab hier wird nix mehr ausgeführt, auch nicht diese Meldung
With pptAppl.ActiveWindow.Selection.ShapeRange
.Left 10
.Top 10
.Width 500
.Height 400
End With
'Neue bzw. aktualisierte Präsentation speichern und schließen
If FileWarDa = False Then
With pptPres
.SaveAs pptFilename
.Close
End With
Else
With pptPres
.Save
.Close
End With
End If
pptAppl.ActivePresentation.Save
'PowerPoint schließen, wenn nicht offen war
If WarOffen = False Then
pptAppl.Quit
End If
Exit Sub
End Sub