Gruppe
Extern
Problem
Auf Grundlage des Diagramms soll eine PowerPoint-Präsentation erstellt und aufgerufen werden. In der Entwicklungsumgebung muss ein Verweis zur Microsoft PowerPointObjektbibliothek hergestellt sein.
StandardModule: Modul1
Sub CreatePPT()
Dim ppt As Object
Dim oPPT As PowerPoint.Application
Dim oPrs As PowerPoint.Presentation
Dim oSld As PowerPoint.Slide
Dim oPct As PowerPoint.Shape
Dim oTxt As PowerPoint.Shape
Dim sPath As String
sPath = Application.DefaultFilePath & "/xl2ppt.ppt"
Set oPPT = CreateObject("PowerPoint.Application")
Set oPrs = oPPT.Presentations.Add(msoCTrue)
Set oSld = oPrs.Slides.Add(1, ppLayoutTitleOnly)
oSld.Shapes.Title.TextFrame.TextRange.Text = "Diagramm-Test"
ActiveSheet.ChartObjects(1).Copy
Set oTxt = oSld.Shapes(1)
With oTxt
.Left = 50
.Top = 0
.Width = 650
.Height = 50
With .TextFrame
With .TextRange
With .Font
.Name = "Arial"
.Size = 24
.Bold = msoCTrue
End With
End With
.AutoSize = ppAutoSizeShapeToFitText
End With
End With
With oTxt.AnimationSettings
.Animate = msoTrue
.EntryEffect = ppEffectBoxIn
.TextLevelEffect = ppAnimateByAllLevels
.AnimateBackground = msoTrue
.TextUnitEffect = ppAnimateByCharacter
.AdvanceMode = ppAdvanceOnTime
End With
Set oPct = oSld.Shapes.Paste(1)
oPrs.SaveAs sPath
oPrs.Close
Set oPct = Nothing
Set oTxt = Nothing
Set oSld = Nothing
Set oPrs = Nothing
Set oPPT = Nothing
Application.Wait Now + TimeSerial(0, 0, 3)
Set ppt = GetObject(sPath)
ppt.SlideShowSettings.Run
End Sub