Creating PowerPoint

[Paleo]

Is there a way I may create a PowerPoint file through VBA in excel?

[Jacob Hilderbrand]

Try this

Option Explicit
 
 Sub Macro1()
Dim AppPPT          As Object
 Dim Pre             As Object
Set AppPPT = CreateObject("Powerpoint.Application")
     Set Pre = AppPPT.Presentations.Add
     AppPPT.Visible = True
End Sub

[Paleo]

Great Jacob,

but what about putting some content in it and saving it? I mean creating more than one slide.

[Paleo]

Hi Jacob,

I have tried to create the code by my own, but it didnt work (what a surprise, hum?? ).

Well, anyway to code is here if can help me out.

Sub Macro1()
    Dim AppPPT As Object
    Dim Pre As Object
Set AppPPT = CreateObject("Powerpoint.Application")
    Set Pre = AppPPT.Presentations.Add
    AppPPT.Visible = True
    With AppPPT
        .ActiveWindow.View.GotoSlide Index:=ActivePresentation.Slides.Add(Index:=1, Layout:=ppLayoutTitle).SlideIndex
        .ActiveWindow.Selection.SlideRange.Shapes("Rectangle 2").Select
        .ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select
        .ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1, Length:=0).Select
        With .ActiveWindow.Selection.TextRange
            .text = "Presentation"
            With .Font
                .Name = "Arial"
                .Size = 44
                .Bold = msoFalse
                .Italic = msoFalse
                .Underline = msoFalse
                .Shadow = msoFalse
                .Emboss = msoFalse
                .BaselineOffset = 0
                .AutoRotateNumbers = msoFalse
                .Color.SchemeColor = ppTitle
            End With
        End With
        .ActiveWindow.Selection.SlideRange.Shapes("Rectangle 3").Select
        .ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select
        .ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1, Length:=0).Select
        With .ActiveWindow.Selection.TextRange
            .text = "Presenter"
            With .Font
                .Name = "Arial"
                .Size = 32
                .Bold = msoFalse
                .Italic = msoFalse
                .Underline = msoFalse
                .Shadow = msoFalse
                .Emboss = msoFalse
                .BaselineOffset = 0
                .AutoRotateNumbers = msoFalse
                .Color.SchemeColor = ppForeground
            End With
        End With
        .ActiveWindow.Selection.Unselect
        .ActiveWindow.View.GotoSlide Index:=ActivePresentation.Slides.Add(Index:=2, Layout:=ppLayoutText).SlideIndex
        .ActiveWindow.Selection.SlideRange.Shapes("Rectangle 2").Select
        .ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select
        .ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1, Length:=0).Select
        With .ActiveWindow.Selection.TextRange
            .text = "Title text"
            With .Font
                .Name = "Arial"
                .Size = 44
                .Bold = msoFalse
                .Italic = msoFalse
                .Underline = msoFalse
                .Shadow = msoFalse
                .Emboss = msoFalse
                .BaselineOffset = 0
                .AutoRotateNumbers = msoFalse
                .Color.SchemeColor = ppTitle
            End With
        End With
        .ActiveWindow.Selection.SlideRange.Shapes("Rectangle 3").Select
        .ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select
        .ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1, Length:=0).Select
        With .ActiveWindow.Selection.TextRange
            .text = "Item 1" + Chr$(CharCode:=13) + "Item 2"
            With .Font
                .Name = "Arial"
                .Size = 32
                .Bold = msoFalse
                .Italic = msoFalse
                .Underline = msoFalse
                .Shadow = msoFalse
                .Emboss = msoFalse
                .BaselineOffset = 0
                .AutoRotateNumbers = msoFalse
                .Color.SchemeColor = ppForeground
            End With
        End With
        .ActiveWindow.Selection.Unselect
        .ActivePresentation.SaveAs Filename:="C:\Documents and Settings\PALEO\My documents\test.ppt"
    End With
End Sub

[Jacob Hilderbrand]

Ok, see if this helps you out. In the VBE set a reference to Microsoft PowerPoint #.# Object Library. The # will vary based on your version of Office (i.e. 9.0 = 2000, 10.0 = XP, 11.0 = 2003).

Option Explicit
 
 Sub Macro1()
Dim AppPPT          As New PowerPoint.Application
     Dim Pre             As Presentation
     Dim Sld             As Slide
Set Pre = AppPPT.Presentations.Add
     AppPPT.Visible = True
     Set Sld = Pre.Slides.Add(Index:=1, Layout:=ppLayoutText)
     With Sld
         .Shapes(1).TextFrame.TextRange.Text = "Title"
         .Shapes(2).TextFrame.TextRange.Text = "Main Document"
     End With
End Sub

When you want to add another slide just change the index number to 2, then 3 etc. Or it can be a variable inside of a loop.

[Paleo]

Great Jacob,

worked just fine!! Thanks!!

[Jacob Hilderbrand]

You're Welcome

Take Care