Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Thema

Diagramm zu PowerPoint-Präsentation konvertieren und aufrufen

Gruppe

PowerPoint

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.

Lösung
Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.

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